Buongiorno a tutti,
scrivo in questo forum per ricevere un vostro prezioso aiuto in merito ad una Macro che ho creato all'interno di un file Excel 2013.
Il file Excel serve a gestire la prenotazione di alcuni strumenti di Laboratorio.
Esso si basa su una lista di richieste di prenotazioni dotate ciascuna di una CheckBox, che l'utente spunterà ogni volta che richiede una nuova prenotazione.
Ogni volta che una CheckBox viene spuntata, una e-mail automatica viene recapitata al mio indirizzo di posta aziendale per avvisarmi che qualcuno ha prenotato lo strumento.
La Macro che ho creato e che riporto di seguito funziona ma, essendo la lista di richieste composta da 700 righe e quindi 700 CheckBox, vorrei con voi capire se si può usare un ciclo For per minimizzare ed ottimizzare le righe di codice.
Private Sub CheckBox1_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim ASSETID As Object
Dim A As String
Dim B As String
Dim C As String
Dim D As String
A = Range("g7")
B = Range("b7")
C = Range("n7")
D = Range("o7")
If CheckBox1.Value = True Then
If (Application.WorksheetFunction.CountIf(Range("fb8:fb24"), A) = 1) Then
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "e-mail aziendale"
.Subject = "NUOVA PRENOTAZIONE STRUMENTO"
.Body = " HO INSERITO UNA NUOVA PRENOTAZIONE PER LO STRUMENTO " & B & " NEL PERIODO DAL " & C & " AL " & D
.Send
End With
Application.SendKeys "%a"
Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
ElseIf (Application.WorksheetFunction.CountIf(Range("fb25"), A) = 1) Then
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "e-mail aziendale"
.Subject = "NUOVA CALIBRAZIONE STRUMENTO"
.Body = " LO STRUMENTO " & B & " RISULTA IN CALIBRAZIONE DAL " & C & " AL " & D
.Send
End With
Application.SendKeys "%a"
Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
End If
ElseIf CheckBox1.Value = False Then
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "e-mail aziendale"
.Subject = "DISDETTA PRENOTAZIONE STRUMENTO"
.Body = " HO DISDETTO UNA MIA PRENOTAZIONE PER LO STRUMENTO " & B & " NEL PERIODO DAL " & C & " AL " & D
.Send
End With
Application.SendKeys "%a"
Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
End If
End Sub
Ho provato da solo a cercare la soluzione, abbozzando con scarso successo quanto di seguito riportato:
Private Sub CheckBox1_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim ASSETID As Object
Dim A As String
Dim B As String
Dim C As String
Dim D As String
Dim i As Variant
For i = 1 To 700
A = Range("g" & i + 6)
B = Range("b" & i + 6)
C = Range("n" & i + 6)
D = Range("o" & i + 6)
If ("CheckBox" & i) = True Then
If (Application.WorksheetFunction.CountIf(Range("fb8:fb24"), A) = 1) Then
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "e-mail aziendale"
.Subject = "NUOVA PRENOTAZIONE STRUMENTO"
.Body = " HO INSERITO UNA NUOVA PRENOTAZIONE PER LO STRUMENTO " & B & " NEL PERIODO DAL " & C & " AL " & D
.Send
End With
Application.SendKeys "%a"
Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
ElseIf (Application.WorksheetFunction.CountIf(Range("fb25"), A) = 1) Then
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "e-mail aziendale"
.Subject = "NUOVA CALIBRAZIONE STRUMENTO"
.Body = " LO STRUMENTO " & B & " RISULTA IN CALIBRAZIONE DAL " & C & " AL " & D
.Send
End With
Application.SendKeys "%a"
Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
End If
ElseIf ("CheckBox" & i) = False Then
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "e-mail aziendale"
.Subject = "DISDETTA PRENOTAZIONE STRUMENTO"
.Body = " HO DISDETTO UNA MIA PRENOTAZIONE PER LO STRUMENTO " & B & " NEL PERIODO DAL " & C & " AL " & D
.Send
End With
Application.SendKeys "%a"
Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
End If
Next
End Sub
Qualcuno di voi sarebbe così gentile da dirmi dove sbaglio ed eventualmente fornire una soluzione al mio problema?
Grazie a tutti in anticipo,
Valerio
Registrazione
