Rapport de message :*
 

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