Code apercu qui fait défaut

Le 23/06/2013 à 08:51

bonjour a vous tous

j'ai un code pour l'aperçu qui fonctionne bien quand la feuille est remplie avec un minimum de 18 lignes dessous l'entête qui en comporte elle 18 lignes, mais lorsqu'il n'y a qu'une où 17 lignes d'écrite il bug a

 ElseIf DerLig = T(K) Then

voici le code complet

Private Sub Aperçu_Click()
  Dim Sh As Worksheet, DerLig As Long
Dim Hb As HPageBreak, Nb As Long, T()
Dim K As Long, A As Long
Dim X As VbMsgBoxResult

Set Sh = Feuil9 ' Worksheets("Facture")
liste_boutons.Hide
    'Aperçu avant impression de la Feuil1
    Application.EnableEvents = False

    With Sh
        DerLig = .Cells.Find("*", LookIn:=xlValues, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious).Row

        'Nécessaire pour le hpagebreaks
        Application.Goto .Range("A" & DerLig)

        'Déterminer la dernière ligne pour chaque saut horizontal
        'et les placer dans une variable tableau (T)
        If .HPageBreaks.Count > 0 Then
            For Each Hb In .HPageBreaks
                K = K + 1
                ReDim Preserve T(1 To K)
                T(K) = Hb.Location.Row - 1
            Next
        End If
        Application.ScreenUpdating = True
        'Détermine le nombre de pages à imprimer

        If DerLig < 19 Then
            Application.ScreenUpdating = True
            Application.EnableEvents = True
            MsgBox "Aucune donnée dans le tableau." & vbCrLf & _
                "L'impression est annulée.", vbCrLf & _
                vbCrLf & vbInformation + vbOKOnly, "Attention"
            Exit Sub
        ElseIf DerLig = T(K) Then
           Nb = UBound(T)
        Else
            If DerLig > T(K) Then
            Nb = UBound(T) + 1
        End If

        X = MsgBox("Vous allez lancer une impression de " & Nb & " page(s)." & vbCrLf & vbCrLf & _
            "Désirez-vous affectuer une prévisualisation du document qui " & _
            "sera imprimé?", vbYesNoCancel + vbInformation, "Attention")

        'Annulation de l'impression
        If X = vbCancel Then
            .DisplayPageBreaks = False
            Application.EnableEvents = True
            Application.Goto .Range("A1"), True
            Application.ScreenUpdating = True
            Exit Sub
        End If
        Application.ScreenUpdating = False
        DoEvents
 'End With
        'Afficher / masquer les lignes à imprimer
        For A = 1 To Nb
            Select Case A
                Case 1
                    'Afficher seulement la section à imprimer
                    With .Range("D" & .Range("D18").End(xlDown).Row, .Cells(.Range("D18").End(xlDown).Row, "M")).Borders(xlEdgeBottom)
                        .LineStyle = xlContinuous
                        .Weight = xlThin
                        .Color = 0
                    End With

                Case Else
                    If A < Nb - 1 Then
                        'Afficher seulement la section à imprimer
                        With .Range("D" & T(A), .Cells(T(A), "M")).Borders(xlEdgeBottom)
                            .LineStyle = xlContinuous
                            .Weight = xlThin
                            .Color = 0
                        End With
                    Else
                        With .Range("C" & T(A - 1), .Cells(DerLig, "M")).Borders(xlEdgeBottom)
                            .LineStyle = xlContinuous
                            .Weight = xlThin
                            .Color = 0
                        End With
                    End If
            End Select
         Next
        With .PageSetup
            .PrintTitleRows = Sh.Rows("17:18").Address
        End With
        If X = vbYes Then
            .PrintPreview
        ElseIf X = vbNo Then
            .PrintOut
        End If
        .DisplayPageBreaks = False
        Application.Goto .Range("A1"), True
    End If
    End With
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    liste_boutons.Show
End Sub

Pascal

Le 23/06/2013 à 09:43

Bonjour,

Le problème vient peut-être de ta zone d'impression

Cdlt

HPageBreaks, objet

Collection des sauts de page horizontaux situés dans la zone d'impression.

Lorsque la propriété Application, la propriété Count, la propriété Item, la propriété Parent ou la méthode Add est utilisée avec la propriété HPageBreaks :

1 - Pour une zone d'impression automatique, la propriété HPageBreaks s'applique uniquement aux sauts de page de la zone d'impression.

2 - Pour une zone d'impression personnalisée de la même plage, la propriété HPageBreaks s'applique à tous les sauts de page.

Le 23/06/2013 à 09:54

bonjour Jean-Eric

Merci de ta réponse mais en fait comment dois je procédé car le cas ne s'était pas réaliser avant car mes essais se sont fait avec plusieurs lignes

Pascal

Le 23/06/2013 à 10:04

Bonjour,

Si tu as défini une zone d'impression, dans gestionnaire de noms, elle doit apparaître

Sinon envoies ton fichier afin que le forum intervienne.

Cdlt

Le 23/06/2013 à 10:11

Bonjour Jean-Eric

voici mon fichier

d'ailleurs https://forum.excel-pratique.com/excel/mofifier-mode-d-enregistrement-t40939.html est du meme fichier

Pascal

Le 23/06/2013 à 13:23

Re,

A méditer. Cdlt

Sub CompterPagesImprimables()
Dim HFull As Integer, VFull As Integer, Total As Integer
'Nombre de pages imprimable dans la feuille active

    Set tbl = ActiveSheet.Range("A1").CurrentRegion
    Plage = tbl.Address
    'DernièreLigne = tbl.Rows.Count
    'DernièreColonne = tbl.Columns.Count
    MsgBox Plage
    ActiveSheet.PageSetup.PrintArea = maplage
    Set tbl = Nothing

    'ou plus simplement
    ActiveSheet.PageSetup.PrintArea = Range("A1").CurrentRegion.Address
    For Each PB In ActiveSheet.VPageBreaks
        If PB.Extent = xlPageBreakFull Then
            VFull = VFull + 1
        Else
            VPartial = VPartial + 1
        End If
    Next
    'Comme on ne compte que les sauts de pages
    VPartial = VPartial + 1
    MsgBox VFull & " sauts de page plein écran, " & VPartial & _
    " sauts de page de la zone d'impression"

    For Each PB In ActiveSheet.HPageBreaks
        If PB.Extent = xlPageBreakFull Then
            HFull = HFull + 1
        Else
            HPartial = HPartial + 1
        End If
    Next
    'Comme on ne compte que les sauts de pages
    HPartial = HPartial + 1
    MsgBox HFull & " sauts de page plein écran, " & HPartial & _
    " sauts de page de la zone d'impression"
    MsgBox "Nombre de pages total : " & (VPartial * HPartial)
    'Relecture (*)
    With ActiveSheet.PageSetup
        MsgBox "Nb pages horizontales " & .FitToPagesWide 'Marche pas (*)
        MsgBox "Nb pages verticales " & .FitToPagesTall 'Marche pas (*)
    End With

    With ActiveSheet.PageSetup
            .PaperSize = xlPaperA4
            .Zoom = 100
            .FitToPagesWide = HPartial
            .FitToPagesTall = VPartial
    End With
    Set tbl = Nothing

    'Obtenir le nombre de page total selon SilkyRoad
    MsgBox "Nombre de page total : " & ExecuteExcel4Macro("GET.DOCUMENT(50)")
End Sub
'La première Colonne des pages de gauche et la première ligne des pages du haut est 1
'Les autres commencent à PageBreak + 1
'C'est pourquoi la première ligne = 0 (AdV(0) = 0)...
'... et la première colonne = 0 (AdH(0) = 0) afin de pouvoir ajouter 1 à toutes...
'... les premières lignes et première colonnes des pages de la zone d'impression
Le 26/06/2013 à 17:25

Bonjour Jean Eric

merci du lien et de ta réponse qui ont fait mon afffaire , désoler du retard mais travail oblige

d'ailleurs celui ci n'est pas résolu

https://forum.excel-pratique.com/excel/mofifier-mode-d-enregistrement-t40939.html

Pascal

Le 26/06/2013 à 17:30

Bonsoir,

Penses à clore ce sujet.

Cdlt

Rechercher des sujets similaires à "code apercu qui fait defaut"