IALweb Homepage
Forum Home Forum Home > MS Office > Microsoft Office > Microsoft Excel
  New Posts New Posts RSS Feed - [RISOLTO] Msgbox su range fogli
  FAQ FAQ  Forum Search   Events   Register Register  Login Login


REGISTRATEVI su IALWeb forum!

[RISOLTO] Msgbox su range fogli

 Post Reply Post Reply
Author
Message
il_betto View Drop Down
Veterano
Veterano
Avatar

Joined: 13/Giu/2011
Status: Offline
Points: 3542
Post Options Post Options   Thanks (0) Thanks(0)   Quote il_betto Quote  Post ReplyReply Direct Link To This Post Topic: [RISOLTO] Msgbox su range fogli
    Posted: 21/Mag/2019 at 16:16
Ciao a Tutti,


al cui interno appare un messaggio che avvisa l' utente ogni volta che tenta di cambiare il valore di una cella.

vorrei che questo messaggio apparisse soltanto nei primi 12 fogli del file, legati ai mesi,
non nel 13 foglio che contiene l' elenco dei nominativi, nè in altri fogli eventuali che si aggiungeranno.

Ho provato a fare un ciclo For con i = 1 to 12 
mettendo in Questa cartella di lavoro:


Dim PrecValue As Variant

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

   On Error GoTo errore

Dim i as Integer

   Application.EnableEvents = False
   
      For i = 1 to 12
       If PrecValue <> "" And Sheets(i).Target.Columns.Count = 1 And Sheets(i).Target.Rows.Count = 1 Then
          If Sheets(i).Target.Value <> PrecValue Then
              RetVal = MsgBox("Il valore precedente era: " & PrecValue & "; Vuoi Cambiare?", vbOKCancel Or vbQuestion, "Attenzione!")
              If RetVal = vbCancel Then Sheets(i).Target.Value = PrecValue
           Else
              PrecValue = Sheets(i).Target.Value
           End If
       End If
next i

xit:
Application.EnableEvents = True
Exit Sub
errore:
MsgBox Err.Number & " - " & Err.Description
Resume xit

End Sub


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

Dim j ad Integer

For j = 1 to 12
   PrecValue = Sheets(ji).Target.Cells(1, 1).Value

   If Sheets(j).Target.Rows.Count > 1 Or Sheets(j).Target.Columns.Count > 1 Then
      MsgBox "Se cancelli, il range: " & Sheets(j).Target.Address & " non potrà essere ripristinato !!", , "Attenzione!"
   End If

Next j

End Sub


mi dà errore ...

Così come ho provato sostituendo ActiveSheet a Sheets(i)  e mettendo come condizione che ActiveSheet sia diverso dal Foglio_13 ... niente da fare Confused

Grazie mille in anticipo !!



Edited by il_betto - 23/Mag/2019 at 09:54
Back to Top
Sponsored Links


Back to Top
dodo47 View Drop Down
Moderatore
Moderatore
Avatar

Joined: 29/Dic/2008
Location: Italy
Status: Offline
Points: 11685
Post Options Post Options   Thanks (0) Thanks(0)   Quote dodo47 Quote  Post ReplyReply Direct Link To This Post Posted: 21/Mag/2019 at 17:25
Ciao
avrà un nome sto' 13° foglio....quindi escludilo dalle macro change e selectionChange, inserendo all'inizio delle due sub:

If ActiveSheet.Name = "Abilitati" Then Exit Sub

saluti


Edited by dodo47 - 21/Mag/2019 at 17:26
domenico
win 10- office 2016
Back to Top
il_betto View Drop Down
Veterano
Veterano
Avatar

Joined: 13/Giu/2011
Status: Offline
Points: 3542
Post Options Post Options   Thanks (0) Thanks(0)   Quote il_betto Quote  Post ReplyReply Direct Link To This Post Posted: 23/Mag/2019 at 09:30
Ciao dodo, Grazie come sempre !!

Ho fatto così ma il controllo sul valore della cella già inserito non mi funziona più sui primi 12 fogli ... Confused

Mi spiego: vado sul foglio "Abilitati", faccio una modifica e non mi compare più il Msgbox;
vado poi su un altro foglio, es. Dicembre, faccio una modifica su una cella con già presente un valore, e nemmeno lì compare il Msgbox ...


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

   On Error GoTo errore

   Application.EnableEvents = False
   
       If ActiveSheet.Name = "Abilitati" Then
          Exit Sub
       Else
            If PrecValue <> "" And Target.Columns.Count = 1 And Target.Rows.Count = 1 Then
               If Target.Value <> PrecValue Then
                   RetVal = MsgBox("Il valore precedente era: " & PrecValue & "; Vuoi Cambiare?", vbOKCancel Or vbQuestion, "Attenzione!")
                   If RetVal = vbCancel Then Target.Value = PrecValue
               Else
                  PrecValue = Target.Value
               End If
            End If
       End If

xit:
Application.EnableEvents = True
Exit Sub
errore:
MsgBox Err.Number & " - " & Err.Description
Resume xit

End Sub


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

   If ActiveSheet.Name = "Abilitati" Then
      Exit Sub
   Else
        PrecValue = Target.Cells(1, 1).Value

        If Target.Rows.Count > 1 Or Target.Columns.Count > 1 Then
           MsgBox "Se cancelli, il range: " & Target.Address & " non potrà essere ripristinato !!", , "Attenzione!"
        End If
   End If

End Sub


Edited by il_betto - 23/Mag/2019 at 09:36
Back to Top
il_betto View Drop Down
Veterano
Veterano
Avatar

Joined: 13/Giu/2011
Status: Offline
Points: 3542
Post Options Post Options   Thanks (0) Thanks(0)   Quote il_betto Quote  Post ReplyReply Direct Link To This Post Posted: 23/Mag/2019 at 09:53
Risolto !! LOL LOL


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

   On Error GoTo errore

   Application.EnableEvents = False
   
       If ActiveWorkbook.ActiveSheet.Name <> "Abilitati" Then
            If PrecValue <> "" And Target.Columns.Count = 1 And Target.Rows.Count = 1 Then
               If Target.Value <> PrecValue Then
                   RetVal = MsgBox("Il valore precedente era: " & PrecValue & "; Vuoi Cambiare?", vbOKCancel Or vbQuestion, "Attenzione!")
                   If RetVal = vbCancel Then Target.Value = PrecValue
               Else
                  PrecValue = Target.Value
               End If
            End If
       End If

xit:
Application.EnableEvents = True
Exit Sub
errore:
MsgBox Err.Number & " - " & Err.Description
Resume xit

End Sub


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

   If ActiveWorkbook.ActiveSheet.Name <> "Abilitati" Then
        PrecValue = Target.Cells(1, 1).Value

        If Target.Rows.Count > 1 Or Target.Columns.Count > 1 Then
           MsgBox "Se cancelli, il range: " & Target.Address & " non potrà essere ripristinato !!", , "Attenzione!"
        End If
   End If


Back to Top
dodo47 View Drop Down
Moderatore
Moderatore
Avatar

Joined: 29/Dic/2008
Location: Italy
Status: Offline
Points: 11685
Post Options Post Options   Thanks (0) Thanks(0)   Quote dodo47 Quote  Post ReplyReply Direct Link To This Post Posted: 23/Mag/2019 at 10:44
e certo che non ti funziona più, visto che comunque disabiliti gli eventi:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   On Error GoTo errore
   Application.EnableEvents = False '<<<<<<
       If ActiveSheet.Name = "Abilitati" Then
          Exit Sub '<<<<< uscendo gli eventi restano disabilitati !!!!!
       Else

Ti avevo detto che quella istruzione andava messa "ad inizio" sub !!
pertanto:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo errore
If ActiveSheet.Name = "Abilitati" Then Exit sub
Application.EnableEvents = False
If PrecValue <> "" And Target.Columns.Count = 1 And Target.Rows.Count = 1 Then
....
....


saluti


Edited by dodo47 - 23/Mag/2019 at 10:46
domenico
win 10- office 2016
Back to Top
il_betto View Drop Down
Veterano
Veterano
Avatar

Joined: 13/Giu/2011
Status: Offline
Points: 3542
Post Options Post Options   Thanks (0) Thanks(0)   Quote il_betto Quote  Post ReplyReply Direct Link To This Post Posted: 23/Mag/2019 at 11:03
Dodo, che svista !!!! Si vede che sto invecchiando !!! Clap Clap

Ho provato come mi hai detto e funziona alla grande !!!


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

   On Error GoTo errore

   If ActiveSheet.Name = "Abilitati" Then Exit Sub
   
   Application.EnableEvents = False
   

      If PrecValue <> "" And Target.Columns.Count = 1 And Target.Rows.Count = 1 Then
               If Target.Value <> PrecValue Then
                   RetVal = MsgBox("Il valore precedente era: " & PrecValue & "; Vuoi Cambiare?", vbOKCancel Or vbQuestion, "Attenzione!")
                   If RetVal = vbCancel Then Target.Value = PrecValue
               Else
                  PrecValue = Target.Value
               End If
      End If


xit:
Application.EnableEvents = True
Exit Sub
errore:
MsgBox Err.Number & " - " & Err.Description
Resume xit

End Sub


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

   If ActiveSheet.Name = "Abilitati" Then Exit Sub
   
        PrecValue = Target.Cells(1, 1).Value

        If Target.Rows.Count > 1 Or Target.Columns.Count > 1 Then
           MsgBox "Se cancelli, il range: " & Target.Address & " non potrà essere ripristinato !!", , "Attenzione!"
        End If


End Sub



Edited by il_betto - 23/Mag/2019 at 11:04
Back to Top
 Post Reply Post Reply
  Share Topic   

Forum Jump Forum Permissions View Drop Down

Forum Software by Web Wiz Forums® version 10.17
Copyright ©2001-2013 Web Wiz Ltd.

This page was generated in 0,063 seconds.