Discussion :

[GoFio]

Bonjour,

J'ai des tableaux comportant des données s’étalant sur une ou plusieurs dizaines de colonnes et plusieurs centaine sde lignes.
A partir de ses tableaux, je dois générer des annexes.
C'est en gros un copier-coller avec de la mise en forme (pour une impression lisible).

Toutes les colonnes doivent tenir sur la largeur de la page et les noms des colonnes doivent êtres répétées en début de chaque pages.
On a l'option de choisir A2, A3, portrait, paysage. (cette action est effectuée en amont et fonctionne pour le moment )

Le problème est que j'ai des cellules fusionnées notamment sur la première colonnes que je ne souhaites pas diviser pour l'impression. J'étais partis su ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Sub MiseEnPage()
    Dim lignetot As Integer, i As Integer, debut As Integer, ligneselec As Integer, n As Integer
    Dim a As Integer, b As Integer
 
    If UserForm8.ComboBox2.Value <> "Zones" Then    'Calcul du nombre de ligne total ET attribution du nombre de cellules à recopier à caque début de pages en fonction du l'onglet (Zones ou Matériels/Résultats)
        lignetot = Range("A1", Range("A1").End(xlDown)).Rows.Count 'lecteur du nombre de ligne totale
        ligneselec = 1 'On recopie la 1ère ligne à chaque début de page
    Else
        lignetot = Range("B4", Range("B4").End(xlDown)).Rows.Count + 3 'lecteur du nombre de ligne totale feuille zones (différent à cause des fusions)
        ligneselec = 3 ''On recopie les 3 premières ligne à chaque début de page
    End If
 
    If UserForm8.OptionButton3.Value = True Then 'Prise en compte du nombre de ligne d'une page en fonction de son orientation (portrait/paysage)
        debut = 50 'nb lignes portrait
    Else
        debut = 30 'nb lignes paysages
    End If
 
    i = debut
    While i < lignetot
        If Cells(i, 1).Value <> "" Then
            For n = 1 To ligneselec 'insère 1 ou 3 lignes selon l'onglet
                Cells(i, 1).EntireRow.Insert
            Next
            ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Rows(i) 'Ajout saut de page
            Rows("1:" & ligneselec).Select 'Selection les n premières lignes (1 ou 3)
            Selection.Copy 'les copies
            Rows(i).Select
            Rows(i).PasteSpecial 'les colles à la ligne voulue
            lignetot = lignetot + ligneselec 'on actualise le nombre de ligne totale
            i = i + debut ' on passe à la fin de feuille suivante
        Else 'Partie pour Onglet Zones : Pour ne pas séparer une cellules fusionné, on remonte à la cellule fusionné précédente
            While Cells(i, 1).Value = ""
                i = i - 1
            Wend
        End If
    Wend
 
    'PARTIE moins importante pour mon problème
    If UserForm8.ComboBox2.Value = "Résultats" Then 'Pour l'onglet "Résultats" refusionage de la colone E
        For i = 2 To lignetot
            Application.DisplayAlerts = False
                If Cells(i, 5).Value = Cells(i - 1, 5).Value Then
                    a = i - 1
                    While Cells(i, 5).Value = Cells(i - 1, 5).Value
                        i = i + 1
                    Wend
                    i = i - 1
                    b = i
                    Range(Cells(a, 5), Cells(b, 5)).MergeCells = True
                    Range(Cells(a, 5), Cells(b, 5)).VerticalAlignment = xlCenter
                End If
            Application.DisplayAlerts = True
        Next
    End If
 
 
End Sub

Cela fonctionne, mais
Le défaut de ce code est suivant la hauteur des lignes, l'orientation (portrait, paysages) et le format (A3, A4) ; la zone d'impression a variée.
Du coup j'aimerais savoir si il est possible de connaitre le nombre de lignes et le nombre de colonne d'une zone d'impression. et l'attribuer pour ma variable début (pour le nombre de ligne)

Quelqu'un m'a montré l'option "ligne à recopier en haut"
Du coup avec l'enregistreur de macro ça m'a permis de simplifier mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub MiseEnPage()
    Dim lignetot As Integer, i As Integer, debut As Integer, ligneselec As Integer, n As Integer
    Dim a As Integer, b As Integer
 
    If UserForm8.ComboBox2.Value <> "Zones" Then    'Calcul du nombre de ligne total et attribution du nombre de cellules à recopier à caque début de pages en fonction du l'onglet (Zones ou Matériels/Résultats)
        lignetot = Range("A1", Range("A1").End(xlDown)).Rows.Count 'lecteur du nombre de ligne totale
        ligneselec = 1
    Else
        lignetot = Range("B4", Range("B4").End(xlDown)).Rows.Count + 3 'lecteur du nombre de ligne totale feuille zones (différent à cause des fusion)
        ligneselec = 3
    End If
 
    If UserForm8.ComboBox2.Value = "Résultats" Then 'Pour l'onglet "Résultats" refusionage de la colone "Système ventilation"
        Call RefusionResultats(lignetot)
    End If
 
    If ligneselec = 3 Then 'Insère des sauts de page pou éviter de "couper" une cellule fusionnée
       ' Call SautDePage
    End If
 
 
    Application.PrintCommunication = False 'Recopie la ou les premières lignes en "virtuel" (juste pou l'impression)
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$" & ligneselec
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
 
End Sub

Cette méthode est pratique, pas besoin de copier coller, de saut de pages ...
Par contre elle me coupe mes cellules fusionnées.

Donc si quelqu'un sait comment trouver le nombre de ligne d'une zone d'impression variable, cela me serait bien utile afin que je puisse faire des insertions de saut de pages.

Ou si vous connaissez une méthode différentes

J'espère avoir été explicite, en vous remerciant.

[Docmarti]

Bonjour

Donc si quelqu'un sait comment trouver le nombre de ligne d'une zone d'impression variable, cela me serait bien utile afin que je puisse faire des insertions de saut de pages.

La propriété LOCATION te permet de connaître la première ligne de la page suivante tenant compte bien sûr de la hauteur de chacune des lignes. Donc moins 1 pour la dernière ligne de la page actuelle.
Il faut d'abord mettre la feuille en mode Aperçu des sauts de page pour que les sauts de page soient mis à jour:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveWindow.View = xlPageBreakPreview

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
ProchainNumeroPageBreak = 1
 
Set PremiereLigneDeLaPageSuivante = ActiveSheet.HPageBreaks(ProchainNumeroPageBreak).Location
Ligne = PremiereLigneDeLaPageSuivante.Row
Position = PremiereLigneDeLaPageSuivante.Top

[GoFio]

Salut,

Franchement Merci !!!
C'est pile poil ce que je cherchais

J'ai utilisé "Ligne = PremiereLigneDeLaPageSuivante.Row", je n'ai pas bien compris "Position = PremiereLigneDeLaPageSuivante.Top"
Pour exemple j'avais Ligne = 66
et Position = 975 (mais ce n'étais pas un bas de page)

Je met mon code pour ceux que ça interesserait

SUB1 : Recopier une ou plusieurs lignes en début de chaque page :
Pour visualiser le résultat, effectuez un aperçu avant impression.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Sub MiseEnPage()
    Dim ligneselec As Integer
 
        ligneselec = 1 'Donner la valeur souhaitée
 
    'Si vous n'avez toujours qu'une ligne à recopier,
    'remplacer .PrintTitleRows = "$1:$" & ligneselec par .PrintTitleRows = "$1:$1"
 
    Application.PrintCommunication = False 
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$" & ligneselec 
        '.PrintTitleColumns = "" Même fonction mais pour les colonnes
    End With
    Application.PrintCommunication = True
 
 
End Sub

SUB2 : Ne pas "couper" les cellules fusionnée de la première colonne lors d'une impression
Action : dans une cellule fusionnée, la valeur n'est présente que dans une seule cellule les autres sont vides.
Donc je passe de bas de page en bas de page. Si la cellule est vide je remonte jusqu'à trouver une cellule non vide et j'insère un saut de page.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub SautDePage()
 
    Dim i As Integer, ligne As Integer, position As Integer, ProchainNumeroPageBreak As Integer, debut As Integer, lignetot as Integer
    Dim PremiereLigneDeLaPageSuivante As Object
 
    ActiveWindow.View = xlPageBreakPreview
 
    ProchainNumeroPageBreak = 1
    Set PremiereLigneDeLaPageSuivante = ActiveSheet.HPageBreaks(ProchainNumeroPageBreak).Location
    ligne = PremiereLigneDeLaPageSuivante.Row
    position = PremiereLigneDeLaPageSuivante.Top
 
    debut = ligne - 1
    lignetot = Range("B1", Range("B1").End(xlDown)).Rows.Count 'Calcul le nombre de ligne totale remplie
    'Manip à effectuer sur une colonne ou il n'y a pas de cellule fusionnée.
 
    i = debut
    While i < lignetot
        If Cells(i, 1).Value <> "" Then 'Si la cellule est non vide
            ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Rows(i) 'Ajout saut de page
            i = i + debut ' on passe à la fin de feuille suivante
        Else 'Partie pour Onglet Zones : Pour ne pas séparer une cellules fusionnées, on remonte à la cellule fusionné précédente
            While Cells(i, 1).Value = ""
                i = i - 1
            Wend
        End If
    Wend
 
End Sub

J'ai garder l'essentiel en supprimant des données propres à mon code, mais normalement ça fonctionne
N’hésite pas à proposer des choses pour améliorer le code
En espérant que ça pourra être utile à certain.

Encore Merci à Docmarti pour son aide !

[Docmarti]

Bonjour GoFio

Merci pour ton code qui est intéressant.

Essaie cette version plus simple et plus versatile.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Option Explicit
 
Sub SautDePageCellulesFusionnees()
 'par Docmarti 2014/05/13
 
    Dim PremiereLigneDeLaPageSuivante As Object
    Dim f As Worksheet
 
    Dim ProchainNumeroPageBreak As Long
    Dim Ligne As Long
 
    Set f = ThisWorkbook.ActiveSheet
 
    ActiveWindow.View = xlPageBreakPreview
 
    f.ResetAllPageBreaks
 
    ProchainNumeroPageBreak = 1
 
    While ProchainNumeroPageBreak <= f.HPageBreaks.Count
 
        Set PremiereLigneDeLaPageSuivante = f.HPageBreaks(ProchainNumeroPageBreak).Location
 
        Ligne = PremiereLigneDeLaPageSuivante.Row
 
        If f.Cells(Ligne, 1).Value = "" And f.Cells(Ligne, 1).MergeCells = True Then
 
            While f.Cells(Ligne, 1).Value = ""
 
                Ligne = Ligne - 1
 
            Wend
 
            Set f.HPageBreaks(ProchainNumeroPageBreak).Location = f.Cells(Ligne, 1)
 
        End If
 
        ProchainNumeroPageBreak = ProchainNumeroPageBreak + 1
 
    Wend
 
End Sub

[Docmarti]

Cette version, encore plus versatile, n'exige pas de valeur dans la zone fusionnée.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Sub SautDePageCellulesFusionnees()
 'par Docmarti 2014/05/13
 
    Dim PremiereLigneDeLaPageSuivante As Object
    Dim f As Worksheet
 
    Dim ProchainNumeroPageBreak As Long
    Dim Ligne As Long
 
    Set f = ThisWorkbook.ActiveSheet
 
    ActiveWindow.View = xlPageBreakPreview
 
    f.ResetAllPageBreaks
 
    ProchainNumeroPageBreak = 1
 
    While ProchainNumeroPageBreak <= f.HPageBreaks.Count
 
       Set PremiereLigneDeLaPageSuivante = f.HPageBreaks(ProchainNumeroPageBreak).Location
 
        Ligne = PremiereLigneDeLaPageSuivante.Row
 
        'Verifier si la cellule de la colonne A est fusionnée
        If f.Cells(Ligne, "A").MergeCells = True Then
 
            Set f.HPageBreaks(ProchainNumeroPageBreak).Location = f.Cells(Ligne, "A").MergeArea.Cells(1, 1)
 
        End If
 
        ProchainNumeroPageBreak = ProchainNumeroPageBreak + 1
 
    Wend
 
End Sub