Dopo la parentesi, lunga, impegnativa e molto interessante, del corso per Sommelier concluso a metà Giugno, eccomi a proporre un altro articolo sul VBA.
Come sa bene chi mi conosce, sono un tipo discretamente disordinato, quando poi ho tantissimo da fare la mia scrivania sembra un puzzle ancora da assemblare.
Dopo aver tanto studiato è necessaria la pratica per potersi tenere aggiornati, quindi ho la necessità di tenere nei pressi del mio pc un bel bicchiere di vino da poter gustare e apprezzare.
Vi ho già confessato di essere un pochino disordinato, quindi lo spazio disponibile per poter appoggiare in maniera stabile un bicchiere, magari un bel bicchiere ballon di Barolo, per far ingelosire Davide, è molto scarso.
Ho pensato: “Vuoi vedere che con Excel riesco a riorganizzare lo spazio e trovare una stabile base di appoggio?”.
Eccomi all’opera e questo è il risultato.
http://www.rifici.it\public\DoveAppoggiarelaBevanda.xls
Leggete la parte sottostante dopo aver provato il file.
Naturalmente ho scherzato, l’introduzione serviva solo a sviare l’attenzione dall’argomento vero.
Ho realizzato questo programma per spiegare come utilizzare da Excel una libreria già presente all’interno del sistema operativo, per poter comandare dei dispositivi esterni, in questo caso è il cdrom, ma il concetto di base è identico anche per altri dispositivi.
Prima di spiegare il funzionamento, una piccola precisazione: nei personal computer fissi il cdrom è servoassistito, quindi funzionano entrambi i tasti di apertura e chiusura; con i portatili, essendo il cd di tipo manuale, il pulsante “apri” funziona in quanto sgancia il piatto e fa aprire il portacd, ma il tasto di chiusura non funziona, in quanto la chiusura deve avvenire a mano.
Entriamo ora nel vivo dell’argomento: all’interno del modulo 1 dichiariamo che utilizzeremo i servizi messi a disposizione dalla libreria “winmm.dll” che da ora utilizzeremo con l’alias "mciSendStringA".
La subroutine “Apri” serve, come dice il nome, ad aprire il cassetto portacd, lo fa dopo aver perso un po’ di tempo per fare scena e simulare un calcolo che in effetti non esiste.
La subroutine “Chiudi” serve a chiudere il cassetto portacd.
Come al solito, il codice è ampiamente commentato (righe verdi) per poterlo modificare a piacere.
Saluti Calo
"Modulo1"
Option Explicit
'Utilizziamo la libreria "winmm.dll" che normalmente si trova nella
'cartella "C:\WINDOWS\system32" questa libreria si occupa di alcune funzioni multimediali di Windows e per quanto ci riguarda alcune funzioni del cdrom.
Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
"Sub Apri"
Private Sub Apri_Click()
Dim CU_Colonna
Dim CU_Ciclo
'Le prossime istruzioni servono solo a perdere tempo
' diminuendo il numero 8 it tutto funzionerà più speditamente.
'Aumentando il numero 8 avremo un rallentamento dell'operazione
'Questo ciclo serve a far andare avanti e indietro per 8 volte la striscia rossa
For CU_Ciclo = 1 To 8
'Questo ciclo serve a far andare avanti la striscia rossa
For CU_Colonna = 3 To 240
Worksheets("Bibita").Cells(29, CU_Colonna).Interior.ColorIndex = 3
Worksheets("Bibita").Cells(30, CU_Colonna).Interior.ColorIndex = 3
Worksheets("Bibita").Cells(31, CU_Colonna).Interior.ColorIndex = 3
Worksheets("Bibita").Cells(32, CU_Colonna).Interior.ColorIndex = 3
Worksheets("Bibita").Cells(33, CU_Colonna).Interior.ColorIndex = 3
Worksheets("Bibita").Cells(29, CU_Colonna - 1).Interior.ColorIndex = 2
Worksheets("Bibita").Cells(30, CU_Colonna - 1).Interior.ColorIndex = 2
Worksheets("Bibita").Cells(31, CU_Colonna - 1).Interior.ColorIndex = 2
Worksheets("Bibita").Cells(32, CU_Colonna - 1).Interior.ColorIndex = 2
Worksheets("Bibita").Cells(33, CU_Colonna - 1).Interior.ColorIndex = 2
Next
'Questo ciclo serve a far tornare indietro la striscia rossa
For CU_Colonna = 240 To 3 Step -1
Worksheets("Bibita").Cells(29, CU_Colonna).Interior.ColorIndex = 3
Worksheets("Bibita").Cells(30, CU_Colonna).Interior.ColorIndex = 3
Worksheets("Bibita").Cells(31, CU_Colonna).Interior.ColorIndex = 3
Worksheets("Bibita").Cells(32, CU_Colonna).Interior.ColorIndex = 3
Worksheets("Bibita").Cells(33, CU_Colonna).Interior.ColorIndex = 3
Worksheets("Bibita").Cells(29, CU_Colonna + 1).Interior.ColorIndex = 2
Worksheets("Bibita").Cells(30, CU_Colonna + 1).Interior.ColorIndex = 2
Worksheets("Bibita").Cells(31, CU_Colonna + 1).Interior.ColorIndex = 2
Worksheets("Bibita").Cells(32, CU_Colonna + 1).Interior.ColorIndex = 2
Worksheets("Bibita").Cells(33, CU_Colonna + 1).Interior.ColorIndex = 2
Next
Next
Worksheets("Bibita").Rows(29).Interior.ColorIndex = 2
Worksheets("Bibita").Rows(30).Interior.ColorIndex = 2
Worksheets("Bibita").Rows(31).Interior.ColorIndex = 2
Worksheets("Bibita").Rows(32).Interior.ColorIndex = 2
Worksheets("Bibita").Rows(33).Interior.ColorIndex = 2
MsgBox " Ho teminato il calcolo fare un clik su ok per visualizzare i risultati"
'la prossima è l'istruzione per aprire il piatto del crom
'purtroppo con i portatili pur funzionando l'operazione è meno evidente.
mciSendString "set cdaudio door open", 0, 0, 0
' Il prossimo messaggio ci avvisa mestamente di non aver trovato spazio
MsgBox " Mi dispiace ma l'unico spazio che ho trovato e il piatto porta cd"
End Sub
Private Sub Chiudi_Click()
'la prossima è l'istruzione per chiudere il piatto del crom
'purtroppo con i portatili non esserdo il piatto portacd
' servoassistito il pulsante non funziona.
mciSendString "set cdaudio door closed", 0, 0, 0
End Sub
"Sub Chiudi"
Private Sub Chiudi_Click()
'la prossima è l'istruzione per chiudere il piatto del crom
'purtroppo con i portatili non esserdo il piatto portacd
' servoassistito il pulsante non funziona.
mciSendString "set cdaudio door closed", 0, 0, 0
End Sub
?>
?>
?>