Exécuter Macro an partir d'une autre Feuille |
Titre du sujet : Exécuter Macro an partir d'une autre Feuille par floka61 le 06/06/2013 14:52:43 Bonjour le forum
j'ai un souci avec une macro lorsque je me positionne sur la Feuil2 elle s'éxcute convenablement mais lorsque je l'excute a partir d'une autre feuille appelé Interface elle me donne que le total general sans les sous totaux et les report voici le code :
Sub saut_de_zaza() Dim pb As Object Dim Cpb As Range, C As Range Dim i As Byte, j As Byte, k As Byte Dim ReportSTe As Double, ReportSTf As Double Dim Last As Integer On Error Resume Next '=====================================***Partie 1 : Suppression des sous-totaux============================================================= With Feuil2.Range("A2:A" & Range("A" & Application.Rows.Count).End(xlUp).Row) Do Set C = .Find("Total") If Not C Is Nothing Then Feuil2.Cells(C.Row, "A").EntireRow.Delete End If ' Loop While Not C Is Nothing End With '==================================Partie 2 : Définition auto de la zone d'impression =================================================================================== Feuil2.ResetAllPageBreaks 'purge les sauts de page existants Feuil2.Range("A2").CurrentRegion.Select 'selection l'ensemble du fichier ActiveWindow.Zoom = True 'fait un zoom total Feuil2.PageSetup.PrintArea = "$A$1:" & Range("E" & Application.Rows.Count).End(xlUp).Address '"$A1$E" '===========================================***Partie 3 : gestion des sauts de page ====================================================== For Each pb In Feuil2.HPageBreaks i = i + 1 '***incrémente le n°de saut de page général(Permet de gérer le cas de sauts de pages externes à la zone d'impression) If pb.Extent = xlPageBreakPartial Then j = j + 1 '***incrémente le n°de saut de page de la zone d'impression Set Cpb = Feuil2.HPageBreaks(i).Location If Cpb.Value <> "Report Sous-Total" Then Feuil2.Range(Feuil2.Cells(Cpb.Row - 1, Cpb.Column), Feuil2.Cells(Cpb.Row, Cpb.Column)).EntireRow.Insert (xlShiftDown) Feuil2.Cells(Cpb.Row - 3, Cpb.Column) = "Sous-Total" If j = 1 Then Feuil2.Cells(Cpb.Row - 3, "C").Formula = "=SUM(C2:C" & Cpb.Row - 4 & ")" Feuil2.Cells(Cpb.Row - 3, "D").Formula = "=SUM(D2:D" & Cpb.Row - 4 & ")" Feuil2.Cells(Cpb.Row - 3, "E").Formula = "=SUM(E2:E" & Cpb.Row - 4 & ")" With Feuil2.Range(Feuil2.Cells(Cpb.Row - 3, "A"), Feuil2.Cells(Cpb.Row - 2, "E")) .Interior.ColorIndex = 40 .Font.Bold = True End With Else k = WorksheetFunction.Max(9, Feuil2.HPageBreaks(i - 1).Location.Row) Feuil2.Cells(Cpb.Row - 3, "C").Formula = "=SUM(C" & k & ":C" & Cpb.Row - 4 & ")" Feuil2.Cells(Cpb.Row - 3, "D").Formula = "=SUM(D" & k & ":D" & Cpb.Row - 4 & ")" Feuil2.Cells(Cpb.Row - 3, "E").Formula = "=SUM(E" & k & ":E" & Cpb.Row - 4 & ")" With Feuil2.Range(Feuil2.Cells(Cpb.Row - 3, "A"), Feuil2.Cells(Cpb.Row - 2, "E")) .Interior.ColorIndex = 40 .Font.Bold = True End With End If Feuil2.Cells(Cpb.Row - 2, Cpb.Column) = "Report Sous-Total" Feuil2.Cells(Cpb.Row - 2, "C") = Feuil2.Cells(Cpb.Row - 3, "C") Feuil2.Cells(Cpb.Row - 2, "D") = Feuil2.Cells(Cpb.Row - 3, "D") Feuil2.Cells(Cpb.Row - 2, "E") = Feuil2.Cells(Cpb.Row - 3, "E") End If End If Next '=====================================***Partie 4 : Affichage du total bas de page ==================================================== Last = Feuil2.Range("A" & Application.Rows.Count).End(xlUp).Row + 1 If Feuil2.Cells(Last, "A") <> "Total Général" Then Feuil2.Cells(Last + 1, "A").EntireRow.Insert (xlShiftDown) '**Permet d'étendre la zone d'impression Feuil2.Cells(Last + 1, "A") = "Total Général" With Feuil2.Range(Feuil2.Cells(Last + 1, "A"), Feuil2.Cells(Last + 1, "E")) .Interior.ColorIndex = 45 .Font.Bold = True End With If i = 0 Then Set Cpb = Feuil2.Cells(2, 1) Feuil2.Cells(Last + 1, "C") = "=SUM(C" & WorksheetFunction.Max(9, Cpb.Row - 2) & ":C" & Last & ")+F5" Feuil2.Cells(Last + 1, "D") = "=SUM(D" & WorksheetFunction.Max(9, Cpb.Row - 2) & ":D" & Last & ")+G5" Feuil2.Cells(Last + 1, "E") = "=SUM(E" & WorksheetFunction.Max(9, Cpb.Row - 2) & ":E" & Last & ")+H5" End If exemple_codes_mise_en_forme Unload Me With Feuil2 .PageSetup.PrintArea = "$A$1:" & .Range("E" & .Rows.Count).End(xlUp).Address .PrintPreview '.PrintOut End With End Sub merci de votre aide
|
Forums