Bonjour le forum

 

j'ai un code vba qui fonctionne bien mais seulement pour avoir une bonne disposition lors de l'impression je voudrais réduire le nombre de lignes dans les sauts de pages a 40 ou 35 j'ai essayé plusieurs modifications telle que : 

Range(Cells(Cpb.Row - 1, Cpb.Column), Cells(Cpb.Row + 40, Cpb.Column)).EntireRow.Insert (xlShiftDown)

j'ai voulu aussi créer une variable de cette façon :

dim h as integer  'hauteur de saut de page
h=40

mais j'ai pas su ou la mettre dans le présent code :

Sub InserST()
Dim pb As Object
Dim C As Range
Dim i As Byte, j As Byte, k As Byte
Dim ReportSTe As Double, ReportSTf As Doubl
Dim h As Integer
'Dim Last As Integer
ActiveWindow.View = xlPageBreakPreview
'***********************************Partie 1 : Suppression des sous-totaux*******************************************************************************
With ActiveSheet.Range("D16:D" & Range("D" & Application.Rows.Count).End(xlUp).Row)
    Do
        Set C = .Find("Total")
        If Not C Is Nothing Then
            Cells(C.Row, "D").EntireRow.Delete
        End If
    Loop While Not C Is Nothing
End With
 
'***********************************Partie 2 : Définition auto de la zone d'impression*******************************************************************
 
ActiveSheet.PageSetup.PrintArea = "$D$1:" & Range("I" & Application.Rows.Count).End(xlUp).Address
 
'***********************************Partie 3 : gestion des sauts de page*********************************************************************************
i = 0
j = 0
For Each pb In ActiveSheet.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 = ActiveSheet.HPageBreaks(i).Location
        If Cpb.Value <> "Report Sous-Total" Then
            Range(Cells(Cpb.Row - 1, Cpb.Column), Cells(Cpb.Row, Cpb.Column)).EntireRow.Insert (xlShiftDown)
            Cells(Cpb.Row - 3, Cpb.Column) = "Sous-Total"
                If j = 1 Then
                    Cells(Cpb.Row - 3, "I").Formula = "=SUM(I16:I" & Cpb.Row - 4 & ")"
 
                        With Range(Cells(Cpb.Row - 3, "D"), Cells(Cpb.Row - 2, "I"))
                            .Interior.ColorIndex = 40
                            .Font.Bold = True
                        End With
                Else
                    k = WorksheetFunction.Max(9, ActiveSheet.HPageBreaks(i - 1).Location.Row)
                    Cells(Cpb.Row - 3, "I").Formula = "=SUM(I" & k & ":I" & Cpb.Row - 4 & ")"
 
                        With Range(Cells(Cpb.Row - 3, "D"), Cells(Cpb.Row - 2, "I"))
                            .Interior.ColorIndex = 40
                            .Font.Bold = True
                        End With
                End If
            Cells(Cpb.Row - 2, Cpb.Column) = "Report Sous-Total"
            Cells(Cpb.Row - 2, "I") = Cells(Cpb.Row - 3, "I")
 
        End If
    End If
Next
 
'******************************************Partie 4 : Affichage du total bas de page *****************************************************************************************
 
Last = Range("D" & Application.Rows.Count).End(xlUp).Row
    If Cells(Last, "D") <> "Total Général" Then
        Cells(Last, "D").EntireRow.Insert (xlShiftDown) '**Permet d'étendre la zone d'impression
        Range(Cells(Last + 1, "D"), Cells(Last + 1, "I")).Copy (Cells(Last, "D"))
        Cells(Last + 1, "D").EntireRow.ClearContents
        Cells(Last + 1, "D") = "Total Général"
        ActiveSheet.Cells(Last + 1, "I") = "=SUM(I" & WorksheetFunction.Max(9, Cpb.Row - 2) & ":I" & Last & ")+I5"
        'Cells(Last + 1, "F") = "=SUM(F" & WorksheetFunction.Max(9, Cpb.Row - 2) & ":F" & Last & ")+F5"
 
        With Range(Cells(Last + 1, "D"), Cells(Last + 1, "I"))
            .Interior.ColorIndex = 45
            .Font.Bold = True
        End With
    End If
    ActiveWindow.View = xlNormalView
     'miseEnPageAvantImpression
     'Ajuster
     Application.Dialogs(xlDialogPrint).Show
End Sub

merci d'avance de votre aide et bonne journée

 

 

 

 

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

 

bonjour le Forum bonjour didier

c'est bon j'ai bien trouver la solution encore une fois merci et surtout pour l'accueil

bonne journée
 

 

Bonjour le forum

il faut jamais oublié RESOLU c'est tres important

Merci bonne journée 

 Bonjour le forum 
je travaille actuellement sur un petit projet sous Excel/VBA mais sincèrement je n'arrive pas a m'en sortir. 
j'ai créer un userforme qui contiens 7 optionbuttons correspondant aux nombre de feuilles je voudrais qu'as chaque sélection il me transcris les données dans la feuille qui correspond a l'optionbutton coché actuellement il me transcris dans tous les feuilles et ce n'est pas mon but voici le code : 

Bonjour jean marie, Didier, Myta, le forum

tout d'abord merci pour les conseils j'y tacherai a l'avenir de se conformé aux régles encore une fois désole pour cette petite entorse aux reglements.
 
pour le fichier j'ai pas encore éssayé mais je sais que cette fois c'est la bonne.

mille fois merci jean marie disant que tu me doit un café 

Bonne journée.

bonjour le forum et Mytà

j'ai pas vérifier le fichier donc voici le fichier :

http://www.cijoint.fr/cjlink.php?file=cj201109/cijLC8d7tn.zip

Bonne journée

Salut jean marie

voici le fichier en question voir la feuille "Convocation"

www.cijoint.fr/cjlink.php le fichier etant volmineux j'ai reduit de sa taille en supprimant quelques et l'envoye avec ci-joint

Merci

Bonjour le forum et jean marie

Merci jean pour le code il fonctionne mais apparrament il décale ça tombe pas dans le bon endroit heureusemnt que j'ai eu le réflexe de l'essayé sur trois copie seulement, par contre j'ai adapté un autre code il me signale aucune erreur mais il ne copie rien le voici :
encore une fois merci jean pour ta réponse et bonne journée
 

Bonsoir Didier et le forum
je me trouve actuellement a la maison le fichier en question se trouve au bureau je m'explique en essayant d'être plus claire dans la plage '"A15:G18") c'est a dire le 1 formulaire je dois inscrire manuellement la Date, le lieu et l'heure ces même informations devront être exportées vers les autres formulaires qui sont en nombre de 794 puisque c'est les même informations une macro copier/coller évitera un travaille manuelle de 2 jours entre chaque plages il y a 54 lignes c'est a dire les informations de la plage ("A15:A18") seront copier sur la plage ("A69:G72") et sur ("A123:G126") ainsi de suite et jusq'au dernier formulaire.
j'espere avoir été claire.
Merci Didier