La "X" del msgBox funziona come un "Ok"

[Angelo24Partecipante Angelo24]

Buongiorno a tutti! Avrei un problemino con un codice.

Il codice che allego, attivato da un pulsante "Invia", esegue dei controlli preliminari relativamente alla compilazione di una scheda.

Se c'è qualcosa che non va attiva un msgBox che dice: "Attenzione! Compilare tutti i campi obbligatori. ..."

Se tutto è a posto controlla se il file di destinazione dove devono essere inviati i dati è aperto o chiuso:

- se è aperto un msgBox dice: "Il file di destinazione è al momento in uso. Riprova più tardi";

-se invece è chiuso un msgBox - con all'interno un pulsante "Ok" - dice : "Operazione possibile. Procedere". Si clicca "Ok" e il flusso dati viene inviato al dataBase.

Il mio problema è in quest'ultimo caso. Infatti se l'utente ci ripensa e vuole cambiare qualche campo magari sbagliato e chiude la finestra ("Operazione possibile. Procedere") con la solita "X" rossa in alto a sinistra, senza dare l' "OK", non cambia niente, il flusso dati parte lo stesso, praticamente è come dare l' "Ok". 

Se è possibile avrei bisogno che chiudendo la finestra non si inviino i dati, si possa correggere la scheda e poi si possa riattivare la macro col pulsante "Invia".

Grazie in anticipo!

'---

Option Explicit


Sub TestFileOpened()
'Salva il file
ActiveWorkbook.Save
'Fine salva il file
   Const sFileDataBaseFullName As String = "\\B1110160\db.Orientamento\DataBase.xlsx"
   
   Dim WbDB As Workbook
   Dim bDbIsOpen As Boolean
   
   On Error GoTo GestisciErrori
   With Application
      .Calculation = xlCalculationManual
      .EnableEvents = True
      .ScreenUpdating = True
   End With
   
   With ThisWorkbook
      With .Worksheets("Preparazione invio")
         If .Range("A5") > 0 Then
            MsgBox "Attenzione! Compilare tutti i campi obbligatori. Campi non compilati: " & .Range("A5"), vbExclamation, "Campi obbligatori mancanti"
            With Application
      .Calculation = xlCalculationAutomatic
      .EnableEvents = False
      .ScreenUpdating = False
   End With
            Exit Sub
         End If
      End With
   End With
 
    ' Testa se il file dataBase è aperto (macro attiva).
    If IsFileOpen(sFileDataBaseFullName) Then
        ' Mostra msg se il file è in uso.
        MsgBox "Il file di destinazione è al momento in uso. Riprova più tardi"
        '
    Else
        ' Mostra msg se il file è disponibile.
        MsgBox "Operazione possibile. Procedere"
        ' Apri data base.
        Set WbDB = Workbooks.Open(sFileDataBaseFullName)
        ' Salva il dataBase
        ' WbDB.Save
        bDbIsOpen = True
   End If
   
   
   If bDbIsOpen Then
      
      With ThisWorkbook
         .Activate
         .Worksheets("Scheda").Activate
         .Sheets("Preparazione invio").Range("B3:AY3").Copy
      End With
      
      With WbDB
         With .Worksheets(1)
            With .Range("C5").End(xlDown).Offset(1)
               .PasteSpecial Paste:=xlPasteAllUsingSourceTheme, _
                             Operation:=xlNone, _
                             SkipBlanks:=False, _
                             Transpose:=False
               .PasteSpecial Paste:=xlPasteValues, _
                             Operation:=xlNone, _
                             SkipBlanks:=False, _
                             Transpose:=False
                             Application.CutCopyMode = False
         End With ' .Range("C5").End(xlDown).Offset(1)
              Application.GoTo .Range("A1")
         End With '.Worksheets(1)
         ' salva una copia del database
         Call SalvaCopiaDataBase(WbDB)
         ' chiude salvando la cartella di lavoro
         .Close True
      End With 'WbDb
    End If
RiprendiErrori:
   With Application
      .Calculation = xlCalculationAutomatic
      .EnableEvents = True
      .ScreenUpdating = True
   End With
       
    Exit Sub
GestisciErrori:
    MsgBox "Si è verificato un errore VBA!" & vbNewLine & _
           "Errore n. " & Err.Number & vbNewLine & _
           Err.Description, vbCritical, "Errore VBA"
    Resume RiprendiErrori
End Sub
Sub SalvaCopiaDataBase(WbToCopy As Workbook)
   Const sPercorsoSalvataggio As String = "\\B1110160\\db.Orientamento.Backup\"
   Dim sDataOraSalvataggio As String
   Dim sEst As String
   Dim sNomeFileCopia As String
   sDataOraSalvataggio = Format(Now, "_yyyymmdd_hhmmss")
   With WbToCopy
      sEst = Mid(.Name, InStrRev(.Name, "."))
      sNomeFileCopia = Replace(.Name, sEst, sDataOraSalvataggio & sEst)
      .SaveCopyAs sPercorsoSalvataggio & sNomeFileCopia
   End With
End Sub


Public Function IsFileOpen(FileName As String) As Boolean
'----------------------------------------------------------------------'
'Questa funzione determina se un file è aperto da qualsiasi programma. '
'Restituisce vero o falso                                              '
'----------------------------------------------------------------------'
  Dim FileNum As Long
  Dim ErrNum As Long
  On Error Resume Next
  If FileName = vbNullString Then
      IsFileOpen = False
      Exit Function
  End If
  If Dir(FileName) = vbNullString Then
      IsFileOpen = False
      Exit Function
  End If
  FileNum = FreeFile()
  Err.Clear
  Open FileName For Input Lock Read As #FileNum
  ErrNum = Err.Number
  On Error GoTo 0
  Close #FileNum
  Select Case ErrNum
    Case 0
        IsFileOpen = False
    'Case 70
    '    IsFileOpen = True
    Case Else
        IsFileOpen = True
  End Select
End Function

'---

 

 

 

 

[patelModeratore patel Karma: 51 pts]

prova questo codice e adegualo alle tue esigenze

Sub t()
a = MsgBox("Closing from X is Disabled", 20, "Messaggio")
MsgBox a
End Sub

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Il punto critico è proprio qui:

MsgBox "Operazione possibile. Procedere"

Infatti mostri un semplice messaggio senza altre opzioni, e per default c'è solo il pulsante Ok. Qualsiasi cosa succeda, alla chiusura del messaggio il codice prosegue imperterrito. Fermo restando che con Ctrl-Pausa|Interr è in teoria possibile bloccare l'esecuzione magari fare pasticci col codice...

Se guardi la guida del MsgBox noterai che è possibile aggiungere pulsanti (ad esempio Ok e Annulla) ed è inoltre possibile (anzi consigliatissimo) assegnare la risposta dell'utente a una variabile, che puoi testare:

Sub test()
Dim v As Long
    v = MsgBox("Proseguire?", vbOKCancel)
    If v = vbCancel Then Exit Sub
    MsgBox "Boom!"
End Sub

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Anticipato da patel mentre scrivevo 🙂

[Luca73Partecipante Luca73 Karma: 58 pts]

Ciao anche senza variabile

Sub test()
    if MsgBox("Proseguire?", vbOKCancel) = vbCancel Then Exit Sub
    MsgBox "Boom!"
End Sub

 

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Luca73 ha scritto:

anche senza variabile

Anche senza If, volendo. Bruttissimo, ma si può fare 🙂

Lo proponiamo come prossima sfida?   

[Luca73Partecipante Luca73 Karma: 58 pts]

Lo proponiamo come prossima sfida?    

Eh sì dai....però non vale le sai tutte ....

Comunque io di solito farei qualcosa del genere

Sub pippo()
If MsgBox("Procedo", vbQuestion + vbYesNo, "Attenzione") = vbYes Then
     MsgBox "Procedendo"
Else
      Exit Sub
end if
End Sub

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Luca73 ha scritto:

io di solito farei qualcosa del genere

Sì, anche io faccio così. Adopero una variabile solo se serve elaborare il valore di ritorno del Msgbox nel resto del codice (come è logico aspettarsi). Anche se il Msgbox non è robusto e affidabile perchè interrompibile.

[Luca73Partecipante Luca73 Karma: 58 pts]

Volevo anche sottolineare che di solito uso Yes/no e intercetto la variabile positiva per procedere.

Ciao

Luca

[Luca73Partecipante Luca73 Karma: 58 pts]

Domanda

ma come fai a quotare un pezzo della mia risposta io di solito uso citazione (doppie virgolette sopra il testo) ma è una cosa divers, non mi viene fuori che le ha scritte...

 

[Angelo24Partecipante Angelo24]

 ... si ma ... dicevo ... io a che punto del codice dovrei dovrei inserire tutte istruzioni ...   

[albatros54Moderatore albatros54 Karma: 89 pts]

Angelo24 ha scritto:

Else ' Mostra msg se il file è disponibile. MsgBox "Operazione possibile. Procedere" ' Apri data base. Set WbDB = Workbooks.Open(sFileDataBaseFullName) ' Salva il dataBase

da quello che ho capito, dovresti inserirlo subito dopo l'else

 

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[Angelo24Partecipante Angelo24]

 Grazie Albatros.

 

Provo subto.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Luca73 ha scritto:

ma come fai a quotare un pezzo della mia risposta

Dal tuo post (quindi non in fase di edit della risposta) evidenzio il pezzo di frase che voglio citare, poi clicco su Quote. Stamattina (o era ieri?) però Admin chiariva che ci sono problemi quando la citazione riguarda un utente non registrato. Basta stare un attimo attenti prima di dare invio.

[Angelo24Partecipante Angelo24]

No, purtroppo non funge.

Mi dice è prevista End sub evidenziando "Else", la metto prima di "Else" (non so se va bene) e mi dice "Errore di compilazione: Blocco If senza end if", e via così ...

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Angelo24 ha scritto:

io a che punto del codice dovrei dovrei inserire tutte istruzioni

Al posto della riga con il MsgBox:

MsgBox "Operazione possibile. Procedere"

scrivi l'istruzione di Luca:

if MsgBox("Proseguire?", vbOKCancel) = vbCancel Then Exit Sub

e sei a posto. Mi sembrava che fosse chiaro e invece no 🙂

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Angelo24 ha scritto:

Mi dice è prevista End sub evidenziando "Else", la metto prima di "Else"

Non andare a tentativi, rischi solo di confonderti le idee, cerca di capire la logica.

- se il file è in uso, mostra messaggio e si interrompe

- se il file non è in uso (ramo Else del tuo If) mostra messaggio per proseguire ma nello stesso tempo convalida la scelta dell'utente se, all'ultimo momento, decide di fermarsi. In pratica un if dentro l'If principale. Se l'utente conferma con Ok allora prosegue, altrimenti (Cancel o X rossa) si ferma.

[Angelo24Partecipante Angelo24]

   Ti capisco, ma purtroppo non sono avvezzo. Sono io che devo ancora imparare tanto.

Comunque ti ringrazio e provo subito.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Angelo24 ha scritto:

non sono avvezzo

Non preoccuparti, nessuno nasce imparato, tranne Alfredo (spero che legga   )

[Angelo24Partecipante Angelo24]

Grazie vecchio frac, con queste indicazioni ora cerco di entrare nella logica.

Cerco sempre di farlo... ma dovrei trovare il tempo per impare un po di basi ...

[Angelo24Partecipante Angelo24]

Beato lui!!!!!

[Angelo24Partecipante Angelo24]

Funziona!!!   

Grazie mille.

Riuscite sempre ad aiutarmi   

Saluti a tutti, e anche ai nati imparati.

[Autore]

Articoli