Macro con fogli protetti

Hai un problema con Excel?

Nuova discussione

Macro con fogli protetti
di Viraus (utente non iscritto) data: 29/10/2014 10:29:24
Buongiorno a tutti.. lavorando su Excel ho attivato delle macro che agiscono su 3 fogli di lavoro, il mio problema è che molte celle sono bloccate.
Leggendo questo forum sono riuscito a risolvere in parte il problema, cioè quando attivo le macro riesco a sbloccare le celle solo per il primo foglio e non per gli altri 2, quindi mi erro di debug.
Le macro le ho create tramite registrazione per semplicità e si attivano tramite un CommandButton.

Spero di essere stato abbastanza chiaro, in ogni caso allego il codice.
grazie

Sub Crea_Pulsante()

  ActiveSheet.Unprotect

  
    'Crea un pulsante: 1° coordinata X, 2° coordinata Y DALL'ALTO, 3° larghezza, 4° altezza pulsante
    ActiveSheet.Buttons.Add(610, 950, 170, 70).Select
    
    'Rinomina il pulsante
    Set shp = ActiveSheet.Shapes(Selection.Name)
        With shp.OLEFormat.Object
        .Name = "Button10"
    End With
    
    'Assegna la macro al pulsante
    Selection.OnAction = "Riporto"
    'Inserisce e formatta la didascalia nel pulsante
    Selection.Characters.Text = "Riporto"
    With Selection.Characters(Start:=1, Length:=11).Font
        .Name = "Calibri"
        .FontStyle = "Grassetto"
        .Size = 15
        .ColorIndex = 1
    End With
    
    Range("G81").Select
    
    ActiveSheet.Protect
    
End Sub

di Grograman (utente non iscritto) data: 29/10/2014 10:32:28
Ciao!

Rimanendo il più possibile in linea con il codice originale basta che invece di usare un generico "activesheet" ti muovi di foglio in foglio con un ciclo for

Sub Crea_Pulsante()
  Dim i As Long
  For i = 1 To 3
  
  Worksheets(i).Unprotect
  Worksheets(i).Select
  
    'Crea un pulsante: 1° coordinata X, 2° coordinata Y DALL'ALTO, 3° larghezza, 4° altezza pulsante
    ActiveSheet.Buttons.Add(610, 950, 170, 70).Select
    
    'Rinomina il pulsante
    Set shp = ActiveSheet.Shapes(Selection.Name)
        With shp.OLEFormat.Object
        .Name = "Button10"
    End With
    
    'Assegna la macro al pulsante
    Selection.OnAction = "Riporto"
    'Inserisce e formatta la didascalia nel pulsante
    Selection.Characters.Text = "Riporto"
    With Selection.Characters(Start:=1, Length:=11).Font
        .Name = "Calibri"
        .FontStyle = "Grassetto"
        .Size = 15
        .ColorIndex = 1
    End With
    
    Range("G81").Select
    
      Worksheets(i).Protect
  Next i
    
End Sub

di Viraus (utente non iscritto) data: 29/10/2014 11:14:17
Grazie per la tua risposta.
Ho provato il codice che mi hai inserito ma non funziona... ora ti allego il codice al completo.
Io ho inserito il ciclo for 2 volte ma non funziona.
Un'altra cosa, è possibile fare in modo che sblocca e riblocca senza che mi chieda di inserire la password?
Grazie ancora

Sub Riporto()

Dim i As Long
  For i = 1 To 3
  
  Worksheets(i).Unprotect
  Worksheets(i).Select

'
' Riporto Macro
' Macro registrata il 28/10/2014 da Utente
'
' Scelta rapida da tastiera: CTRL+a
'
    ActiveWindow.SmallScroll Down:=66
    Range("G81:I81").Select
    Selection.Copy
    Range("G79").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G81").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWindow.SmallScroll Down:=6
    Range("G85:I85").Select
    Selection.Copy
    Range("G83").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G85").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("G89:I89").Select
    Selection.Copy
    Range("G87").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G89").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWindow.SmallScroll Down:=3
    Range("G93:I93").Select
    Selection.Copy
    Range("G91:I91").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("G93").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWindow.SmallScroll Down:=6
    Range("H101").Select
    Selection.Copy
    Range("H97").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H101").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sheets("Foglio2").Select
    Range("G18").Select
    ActiveWindow.SmallScroll Down:=3
    Sheets("Foglio3").Select
    Range("L43").Select
    Selection.Copy
    Sheets("Foglio2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=6
    Sheets("Foglio3").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sheets("Foglio3").Select
    ActiveWindow.SmallScroll Down:=-24
    Range("H22").Select
    Selection.Copy
    Range("H5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H22").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sheets("Foglio1").Select
    ActiveWindow.SmallScroll Down:=-81
    Range("A7:J39").Select
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=36
    Range("A41:J52").Select
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=9
    Range("A54:J62").Select
    Selection.ClearContents
    Selection.ClearContents
    Range("A64:J67").Select
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=18
    Sheets("Foglio2").Select
    ActiveWindow.SmallScroll Down:=9
    Range("D20:F46").Select
    Selection.ClearContents
    Range("G20:G46").Select
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=15
    Range("A53:G64").Select
    Selection.ClearContents
    Sheets("Foglio3").Select
    Range("D7:H20").Select
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=21
    Range("B33:H45").Select
    Selection.ClearContents
    Range("G30:H32").Select
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=18
    Sheets("Foglio1").Select
    ActiveWindow.SmallScroll Down:=-69
 'Cancella il pulsante
    ActiveSheet.Shapes.Range(Array("Button10")).Delete
    
    'Imposta un timer che lo ri-genera dopo un tempo determinato
    Application.OnTime Now + TimeValue("00:00:05"), "Crea_Pulsante"
    
      Worksheets(i).Protect
  Next i
    
     
End Sub

Sub Crea_Pulsante()

 Dim i As Long
  For i = 1 To 3
  
  Worksheets(i).Unprotect
  Worksheets(i).Select

  
    'Crea un pulsante: 1° coordinata X, 2° coordinata Y DALL'ALTO, 3° larghezza, 4° altezza pulsante
    ActiveSheet.Buttons.Add(610, 950, 170, 70).Select
    
    'Rinomina il pulsante
    Set shp = ActiveSheet.Shapes(Selection.Name)
        With shp.OLEFormat.Object
        .Name = "Button10"
    End With
    
    'Assegna la macro al pulsante
    Selection.OnAction = "Riporto"
    'Inserisce e formatta la didascalia nel pulsante
    Selection.Characters.Text = "Riporto"
    With Selection.Characters(Start:=1, Length:=11).Font
        .Name = "Calibri"
        .FontStyle = "Grassetto"
        .Size = 15
        .ColorIndex = 1
    End With
    
    Range("G81").Select
    
      Worksheets(i).Protect
  Next i
    
End Sub

di lepat (utente non iscritto) data: 29/10/2014 12:09:15
sarebbe meglio allegare un file di esempio per testare la macro

di Zer0Kelvin (utente non iscritto) data: 29/10/2014 15:25:50
Ciao:
1) segui il consiglio di Patel, sarà un gran risparmio di tempi per tutti
2) frasi come
__________________________________________________
il codice non funziona
__________________________________________________
possono mandare i bestia più di qualcuno
"Non funziona" nel nostro contesto non vuol dire praticamente nulla; bisogna descrivere dettagliatamente l'errore, dove si verifica e l'errore riportato.
3) il tuo codice è pieno di Select, Selection ed altre istruzioni inutili inserite da registratore di macro; sarebbe meglio se imparassi ad ottimizzare il codice eliminando le istruzioni superflue (e anche nocive, in molti casi); vedi esempio più sotto.

    ActiveWindow.SmallScroll Down:=66 'istruzione inutile, poichè il registratore ha registrato lo spostamento verso il basso
    Range("G81:I81").Select
    Selection.Copy
    Range("G79").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks :=False, Transpose:=False

'Le istruzioni sopra possono essere rese più sintetiche:
    Range("G81:I81").Copy '<=per copiare o incollare una cella non serve selezionarla, lo stesso per tutte le operazioni su un range
    Range("G81:I81").PasteSpecial xlPasteValues

di Zer0Kelvin data: 29/10/2014 15:27:28
Un metodo un pò più corretto e flessibile per inserire i pulsanti sarebbe questo

Sub Crea_Pulsante(Sh As Worksheet)
Dim Bt As Object
With Sh
    .Unprotect
    Set Bt = .Buttons.Add(610, 950, 170, 70)
    Bt.OnAction = "Riporto"
    With Bt
        .Name = "Button10"
        .Caption = "Riporto"
        With .Font
            .Name = "Calibri"
            .Bold = True
            .Size = 15
            .ColorIndex = 1
        End With
    End With
    Set Bt = Nothing
    .Protect
End With
End Sub

Sub PulsantiSuTreFogli()
Dim N As Long
    For N = 1 To 3
        Crea_Pulsante ThisWorkbook.Sheets(N)
    Next N
End Sub

di Viraus (utente non iscritto) data: 02/11/2014 17:13:47
Non era mia intenzione offendere qualcuno e mi scuso, il mio "non funziona" stava a significare che inserendo il codice in quel modo la macro non partiva, dandomi errore di debug già alla prima riga, forse perchè l'ho inserito male io, tant'è che dopo ho allegato tutto il codice appunto per farvelo vedere e correggere.
Ho provato a fare le semplificazione che mi hai detto, conoscendo visual basic in maniera molto superficialmente ho parecchie difficoltà, motivo per cui ho preferito registrare la macro.
Volevo chiedere un paio di cose che ancora non riesco a far quadrare. La prima è: avendo il foglio protetto da una password, è possibile eseguire la macro aggirando le protezione ma senza chiedermi la password?
Poi ho un problema nel cancellare il contenuto delle celle, me ne cancella più del dovuto e oltretutto non so se ho fatto giusto il collegamento tra 2 fogli.
ora allego parti di codice per farvi capire meglio...

 Sheets("Foglio3").Select
    Range("H22").Copy    'RIPORTO SPESE GENERALE
    Range("H5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H22").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("D7:H20").ClearContents    'vari contenuti da cancellare, ma oltre questi range mi cancella anche                      altre celle che non dovrebbe
    Range("G30:H32").ClearContents
    Range("B33:H45").ClearContents
    Range("H22").Select

di Viraus (utente non iscritto) data: 02/11/2014 17:36:36
Un'altra parte di codice, dove oltre il range da cancellare non so se ho scritto correttamente il collegamento tra foglio 2 e foglio 3

 Sheets("Foglio3").Select  'RIPORTO ASSEGNI E CONTANTI
    Range("L43").Copy
    Sheets("Foglio2").Select
    Range("G18").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("L43").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sheets("Foglio2").Select
    Range("D20:G4").ClearContents
    Range("A53:G60").ClearContents
    Range("L43").Select

Vuoi Approfondire?