Dim Controllo As Boolean Sub DoppiaMacro_1() 'doppia macro 1/2 click foglio mailstampa Dim avviso As String If Controllo = True Then 'Call seleziona_per_mail Call togli_seleziona_per_mail_1 Controllo = False Else 'Call togli_seleziona_per_mail Call seleziona_per_mail_1 Controllo = True End If End Sub Sub seleziona_per_mail_1() '<<< ok 'foglio mail Application.ScreenUpdating = False Dim Selezione As Range, R As Range, R2 As Range, rng As Range Dim avviso As String Dim I As Long ActiveSheet.Unprotect "987654" 'If Range("X1") = "" Then If Range("A5") = "" Then avviso = MsgBox("non c'è niente da selezionare!", vbExclamation + vbOKOnly + vbDefaultButton2, "AVVISO") If avviso = vbOK Then Exit Sub End If End If Set rng = Range("A3:Q84") For I = rng.Rows.Count To 1 Step -1 If WorksheetFunction.CountA(rng.Rows(I)) = 0 Then rng.Rows(I).EntireRow.Hidden = True End If Next I With Sheets("foglio1").Range("A3:Q84") '<== sostituisci il nome del foglio, oppure usa ActiveSheet For Each R In .Rows For Each R2 In R.Cells If R2 <> "" Then If Selezione Is Nothing Then Set Selezione = R Else Set Selezione = Uni0n(R, Selezione) End If Exit For End If Next R2 Next R End With If Not Selezione Is Nothing Then Selezione.Select Set Selezione = Nothing 'Range("X1") = 1 'ActiveSheet.Protect "987654" ActiveSheet.Protect Password:="987654", DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFormattingCells:=False, AllowInsertingHyperlinks:=False, AllowFiltering:=True Selection.Copy Application.ScreenUpdating = False End Sub Sub togli_seleziona_per_mail_1() '<<< ok 'foglio mail Dim Selezione As Range, R As Range, R2 As Range, rng As Range Dim I As Long ActiveSheet.Unprotect "987654" Application.ScreenUpdating = False Set rng = Range("A3:Q84") For I = rng.Rows.Count To 1 Step -1 If WorksheetFunction.CountA(rng.Rows(I)) = 0 Then rng.Rows(I).EntireRow.Hidden = False End If Next I 'Range("X1") = "" ActiveSheet.Protect "987654" Application.CutCopyMode = False 'End If Application.ScreenUpdating = True Range("A5").Select End Sub
rollis13, 01/08/2022 17:03:Mah, a parte il fatto che la macro: Double Macro_1 non l'ho travata, ho cliccato i pulsanti in tutte le combinazioni di sequenza ma la velocità mi è sembrata sempre la stessa.
Application.ScreenUpdating = False 'Application.DisplayStatusBar = False Application.Calculation = xlCalculationManual 'Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False
'Application.DisplayStatusBar = True Application.Calculation = xlCalculationAutomatic 'Application.EnableEvents = True ActiveSheet.DisplayPageBreaks = True Selection.Copy Application.ScreenUpdating = True
john_cash, 01/08/2022 19:25: Con le 2 aggiunte nelle macro va bene o possono dare problemi? Grazie