Aperçu avant impression d'une plage non vide

**mikadoo57** · 03/01/2013, 22h25

Bonjour,
j'ai un tableau de 13 colonnes et 1200 lignes, ces dernières étant remplies jour après jour par l'utilisateur. Certaines cellules d'une ligne peuvent être vides. La seule colonne dont les cellules sont obligatoirement remplies et qui peut servir pour compter les lignes non vides est la colonne 3 ou "C".

Pour que l'utilisateur puisse imprimer le tableau jusqu'à la dernière ligne non vide, j'ai créé un bouton qui ouvre l'aperçu avant impression et essayé 2 piste :
la première en créant un nom 'zone_d_impression' avec la formule "=DECALER('mafeuille'!$A$2;;;NBVAL('mafeuille'!$C:$C);13)" et en donnant au bouton le code

Code :

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

1
2
3
Private Sub CommandButton3_Click()
Application.Dialogs(xlDialogPrintPreview).Show False
End Sub

Cela fonctionne bien mais dès que l'on touche à la mise en page, une nouvelle zone d'impression type "='mafeuille'!$A$2:$N$4" se crée et fout tout par terre.

En furetant sur la toile, j'ai trouvé un code que j'ai adapté et attribué au bouton :

Code :

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

1
2
3
4
Private Sub CommandButton3_Click()
PageSetup.PrintArea = Range([A2], Columns(13).Find("*", , , , , xlPrevious)).Address 'Columns(13) me permet d'avoir le tableau dans son entièreté
Application.Dialogs(xlDialogPrintPreview).Show False
End Sub

C'est simple mais avec un défaut : c'est que la colonne 13 ("M") sert à déterminer la dernière ligne non vide et les cellules de cette colonne ne sont pas forcément remplies.
Je cherche donc à l'améliorer pour prendre en référence de comptage des lignes non vides la colonne "C".
(je me suis essayé au Rows.count mais je me suis vite noyé dans des erreurs successives et insurmontables pour moi.

Si vous avez une piste pour m'aiguiller, je fonce

Merci

**mikadoo57** · 04/01/2013, 02h06

en fouinant un peu, j"ai trouvé cela :

Code :

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

1
2
3
4
5
6
7
Private Sub CommandButton3_Click()
Dim x As Long
 
x = Sheets("mafeuille_1").Range("a" & Rows.Count).End(xlUp).Row
Sheets("mafeuille_1").Range("a2:l" & x).Copy Sheets("mafeuille_2").Range("a" & Rows.Count).End(xlUp).Offset(1, 0) 'mafeuille_2 est bien sur dans un autre fichier!
 
End Sub

Il me reste à trouver le code pour que la copie se fasse vers un autre fichier. Ouf! ça avance. Bon il est 2h du mat, c'est l'heure pour papy d'aller au lit !
Mais je reste ouvert à toute orientation comme demandé ci-dessus.

**nanousik** · 04/01/2013, 11h41

Essaie comme ceci:

Code :

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

Sheets("mafeuille_1").Range("a2:l" & x).Copy Destination:=Workbooks("Fichier.xls").Worksheets("mafeuille_2").Range("A1")

Tu n'as qu'à remplacer Fichier.xls par le nom du fichier dans lequel tu veux le copier. Tel que je l'ai écrit le tableau de la feuille "mafeuille_1" va être copié sur la cellule A1 de l'autre fichier. Si tu souhaites le copier sur une autre cellule il te suffit de remplacer A1 par la cellule de ton choix.

J'espère que ma réponse t'aidera

**mikadoo57** · 04/01/2013, 21h37

Bonjour, j'ai adapté ton code sur ma macro d'importation de donnée (je clique sur le bouton du fichier de synthèse, cela ouvre et copie la sélection non vide de la feuille "activités" du fichier "activités Recherche" pour la coller sur la feuille "Metz" de mon fichier de synthèse.
Mais cela bloque à la ligne 5 (erreur d'exécution '2147....(800z000b), le focus ne peut être déplacé sur le contrôle car celui-ci est invisible, non activé, etc.)
Voici le code

Code :

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

1
2
3
4
5
6
Sub import()
Dim x As Long
 
Workbooks.Open Filename:="C:\Documents and Settings\vincent\Bureau\pilotage activités\Activités Recherche.xls"
Sheets("Activités").Range("B3:l" & x).Copy Destination:=Workbooks("C:\Documents and Settings\vincent\Bureau\pilotage activités\Activités synthèse ZD-E et FFECSA.xls").Worksheets("Act Metz").Range("B3")
End Sub

Pour information, voici le code un peu laborieux que j'utilisais avant et qui fonctionnait mais en sélectionnant toutes les lignes, même les vides (il se répète 8 fois car il y a 8 fichiers différents !)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Import()
Application.ScreenUpdating = False
 Workbooks.Open Filename:="C:\Documents and Settings\vincent\Bureau\pilotage activités\Activités Recherche.xls"
   Worksheets("Activités").Range("B3:N1202").Copy
 
 Windows("Activités synthèse ZD-E et FFECSA.xls").Activate
    Worksheets("Act Metz").Activate
      Range("B3").Select
       Selection.PasteSpecial Paste:=xlPasteValues
       Selection.PasteSpecial Paste:=xlPasteFormats
     Application.CutCopyMode = False
   Range("A3").Select
 Windows("Activités Recherche.xls").Close savechange = False
End Sub

**mercatog** · 04/01/2013, 22h30

Bonsoir
Ton dernier code pourra être écrit comme ceci

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
Sub Import()
Dim Wbk As Workbook
Dim LastLig As Long
Dim Fichier As String
 
Application.ScreenUpdating = False
Fichier = "C:\Documents and Settings\vincent\Bureau\pilotage activités\Activités Recherche.xls"
If Dir(Fichier) <> "" Then
    Set Wbk = Workbooks.Open(Fichier)
    With Wbk.Worksheets("Activités")
        LastLig = .Cells(.Rows.Count, "C").End(xlUp).Row
        .Range("B3:N" & LastLig).Copy
    End With
 
    With ThisWorkbook.Worksheets("Act Metz").Range("B3")
        .PasteSpecial Paste:=xlPasteValues
        .PasteSpecial Paste:=xlPasteFormats
    End With
 
    Application.CutCopyMode = False
    Wbk.Close False
    Set Wbk = Nothing
End If
End Sub

**mikadoo57** · 04/01/2013, 23h37

Cela marche du tonnerre ! et en plus l'exécution est beaucoup plus rapide.

Encore un code que je vais mettre dans ma boîte à outils car je cherchais depuis longtemps un code simple et didactique pour le comptage des non vides.
Encore merci.

Je vais essayer de l'adapter pour l'intégrer à ma macro printPreview

Code :

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

1
2
3
Private Sub CommandButton3_Click()
Application.Dialogs(xlDialogPrintPreview).Show False
End Sub

car actuellement je défini la zone d'impression avec la fonction DECALER dans un nom zone_d_impression. Cela ne me satisfait pas car pas protégée contre l'action d'un utilisateur qui irait dans le menu de mise en page, ce qui efface la fonction DECALER. Je dirai bientôt où j'en suis !!!

Par ailleurs, dans mon fichier synthèse, je fusionne les données importées dans mes feuilles. Mais lors de la fusion, je n'ai que les valeurs et je suis donc obligé de faire une macro que j'appelle en fin de procédure pour appliquer les formats aux cellules fusionnées. Voici la macro de fusion que j'utilise (elle a été finalisée par un autre membre car je ramais pour simplifier la macro du départ, initiée avec l'enregistreur de macro donc lonnnnnnnnnngue ! ):

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
Private Sub CommandButton2_Click()
    Call import
    Feuil1.Unprotect "xxxx"
    Dim Lig1 As Integer
    Dim Col1 As Integer 
    Dim MaFeuille As Worksheet 
    Dim Ligne As Integer  
 
    Application.ScreenUpdating = False  
 
    Feuil1.Range("A3:N6002").Cells.Clear
 
    Lig1 = 3 
 
    For Each MaFeuille In Sheets 
        If MaFeuille.Name Like "Act*" Then    'dans un but pratique, toutes les feuilles importées (8 sur 15 que compte le fichier) commencent par Act
 
            With MaFeuille
                 For Ligne = 3 To .UsedRange.Row + .UsedRange.Rows.Count
                   If .Cells(Ligne, 2) <> "" Then  
                         For Col1 = 1 To 14
                             Feuil1.Cells(Lig1, Col1).Value = .Cells(Ligne, Col1).Value
                         Next
                         Lig1 = Lig1 + 1
                     End If
                 Next
            End With
 
        End If
    Next
 
    Worksheets("Synthèse ZD-E").Select   'ligne servant à déselectionner "a3:M6002". Ce n'est pas beau mais je n'ai pas d'autre solution
       'Pourquoi pas !
  Call format  'la macro pour mettre bordures, centrage, couleur de police, etc.
 
    Application.ScreenUpdating = True
Feuil1.Protect "xxxx", , True, , , , , , , , , , , , True
End Sub

C'est la ligne 22 qui me gêne car j'ai bien essayé d'intégrer la prise en compte du format (comme dans le PasteSpecial) mais sans succès.

**mikadoo57** · 05/01/2013, 10h49

Bingo ! j'ai réussi à adapter une partie de ton code pour l'aperçu avant impression et cela fonctionne sans problème.

Code :

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

1
2
3
4
5
6
7
8
Private Sub CommandButton3_Click()
Dim lastlig As Long
  With Worksheets("Activités")
        lastlig = .Cells(.Rows.Count, "C").End(xlUp).Row
        Range("A3:M" & lastlig).PrintPreview
 End With
 
End Sub

Reste maintenant mon souci pour la fusion des valeurs et formats des feuilles de mon fichier synthèse. Je m'y attèle mais par tâtonnement ce qui n'est guère rapide §

**Philippe Tulliez** · 05/01/2013, 12h57

Bonjour,
Je ne sais pas si mon intervention est pertinente car je vois que d'une question de zone d'impression on est parti vers une copie sur une autre feuille.
Donc ma réponse porte sur une solution qui me semble simple par rapport à la première question, à savoir de déterminer une zone d'impression qui part de la formule qui semblait te satisfaire mais perturbée lors de la modification de la mise en page par un utilisateur.
Je propose donc de partir de ta formule

Code :

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

=DECALER('mafeuille'!$A$2;;;NBVAL('mafeuille'!$C:$C);13)

Où personnellement j'aurais ajouté -1 à la suite de NBVAL puisque tu pars de la cellule A2.
Cette formule je l'associerais non pas à la référence nommée zone_d'impression mais à un autre nom (par exemple prn_db)
Ensuite voici le code modifié de celui que tu avais mis dans ton post

Code :

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

1
2
3
4
Private Sub CommandButton1_Click()
 PageSetup.PrintArea = ThisWorkbook.Names("prn_db")
 Application.Dialogs(xlDialogPrintPreview).Show False
End Sub

**mikadoo57** · 05/01/2013, 13h50

merci Philippe pour ta réponse.
Concernant l'aperçu avant impression, j'ai adopté finalement le code suivant qui me permet de le copier sans avoir à spécifier de nom dans mes autres feuilles et fichiers :

Code :

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

1
2
3
4
5
6
7
Private Sub CommandButton3_Click()
Dim lastlig As Long
  With ActiveSheet
        lastlig = .Cells(.Rows.Count, "C").End(xlUp).Row
        Range("A3:M" & lastlig).PrintPreview
 End With
 End Sub

Seul subsiste maintenant ce problème (hors sujet par rapport au titre de mon post, je l'admets) de la prise en compte des formats de cellule (bordure, centrage, couleur de police) lors de la fusion des données des différentes feuilles sur une autre feuille, toutes étant dans le même fichier. Je n'arrive pas à trouver la syntaxe pour copier value et format, cette fameuse ligne 22 du code ci-dessous et qui m'oblige à appeler la macro "format" créée pour palier le problème :

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
Private Sub CommandButton2_Click()
    Call import
    Feuil1.Unprotect "xxxx"
    Dim Lig1 As Integer
    Dim Col1 As Integer 
    Dim MaFeuille As Worksheet 
    Dim Ligne As Integer  
 
    Application.ScreenUpdating = False  
 
    Feuil1.Range("A3:N6002").Cells.Clear
 
    Lig1 = 3 
 
    For Each MaFeuille In Sheets 
        If MaFeuille.Name Like "Act*" Then    'dans un but pratique, toutes les feuilles importées (8 sur 15 que compte le fichier) commencent par Act
 
            With MaFeuille
                 For Ligne = 3 To .UsedRange.Row + .UsedRange.Rows.Count
                   If .Cells(Ligne, 2) <> "" Then  
                         For Col1 = 1 To 14
                             Feuil1.Cells(Lig1, Col1).Value = .Cells(Ligne, Col1).Value
                         Next
                         Lig1 = Lig1 + 1
                     End If
                 Next
            End With
 
        End If
    Next
 
    Worksheets("Synthèse ZD-E").Select   'ligne servant à déselectionner "a3:M6002". Ce n'est pas beau mais je n'ai pas d'autre solution
       'Pourquoi pas !
  Call format  'macro rajoutée pour mettre bordures, centrage, couleur de police, etc.
 
    Application.ScreenUpdating = True
Feuil1.Protect "xxxx", , True, , , , , , , , , , , , True
End Sub

**Philippe Tulliez** · 05/01/2013, 14h03

Bonjour,
Ce que tu veux faire, c'est copier valeurs + formats de plusieurs feuilles sur une seule dans le même classeur ?

**mikadoo57** · 05/01/2013, 15h08

Exact. Actuellement la macro de fusion (je l'appelle comme cela) ne recopie que les valeurs des cellules des autres feuilles sans aucun format

**Philippe Tulliez** · 05/01/2013, 15h32

Bonjour,

C'est amusant parce-que je suis justement occupé à finaliser une procédure qui permet de recopier une feuille vers une autre en l'ajoutant et qui permettra de faire exactement cela.
J'espère la terminer ce soir ou demain et je la placerai dans les contributions.

**mikadoo57** · 05/01/2013, 16h04

Merci. J'attends avec impatience

**Philippe Tulliez** · 05/01/2013, 16h12

Bonjour,
Je dois encore finaliser 2, 3 petite choses mais il est déjà en version test et je dois encore préparer des explications, le classeur Demo etc.. avant de le publier.
Donc si toi ou d'autres souhaites le tester, cela m'intéresse d'avoir les réactions et un retour de bugs éventuels qui m'auraient échappé.

La procédure ExportTable (Ce n'est peut-être pas son nom définitif) est une fonction (qui renverra dans sa version finale une valeur) permet d'ajouter une feuille dans une autre (pour en copier plusieurs il faut donc faire une autre procédure qui fait une boucle sur la collection WorkSheets
Les feuilles doivent être identiques (Même nombre de colonnes et la première ligne doit avoir les mêmes Labels - Une vérification est faite)
Cette procédure a plusieurs arguments qui permet entre autres de faire un delete de la feuille de réception et aussi d'effacer les formules donc recopie des valeurs.
La procédure vérifie si la longueur des colonnes est identique à la première lignes et vérifie aussi la parfaite cohérence de chaque cellule de la première ligne (Ex - Si on copie une feuille Janvier vers la feuille Export la cellule C1 de l'une contient Naissance et l'autre Naiss, la fonction ne fait pas la copie.
Un message d'erreur s'affiche mais je prévois pour la version finale un argument pour le couper.

La constante en début de module est le nom de la feuille d'exportation. Cette feuille peut-être vide

La procédure qui lance la fonction
Il faut prévoir un Select Case ou un IF pour les feuilles à ne pas copier mais la procédure ne prends pas en compte le nom de la feuille d'export.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Option Explicit
Const ExportName As String = "report"
Sub ReportDataAllSheets()
 Dim shtReport As Worksheet
 Dim WS As Worksheet
 Dim count As Integer, Num As Integer
 Set shtReport = ThisWorkbook.Worksheets(ExportName) ' Nom à changer
 Application.ScreenUpdating = False
 For Each WS In ThisWorkbook.Worksheets
  ' Le compteur (Count)permet de
  ExportTable WS, shtReport, IsFirst:=Abs(count = 0), ValueOnly:=True: count = count + 1
 Next WS
 Application.ScreenUpdating = True
End Sub

La fonction

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
59
60
61
62
63
64
65
66
67
68
69
70
Function ExportTable(FromSheet As Worksheet, ToSheet As Worksheet, Optional ValueOnly As Boolean = False, Optional IsFirst As Boolean = False) As Long
 ' Copie données contenues ds feuille (FromSheet) vers feuille (ToSheet)
 ' Contrainte la 1ère colonne est toujours A1
 ' Auhor : Philippe Tulliez http://philippe.tulliez.be
 ' Date  : (04/01/2013)
 ' Version 1.0 version Beta
 ' Update
 ' 00/00/0000-x.x
 ' Arguments
 ' FromSheet - WorkSheet Feuille d'où viennent les données
 ' ToSheet   - WorkSheet Feuille de destination
 ' [ValueOnly] - Boolean [d:FALSE] Si TRUE copie les valeurs
 ' [IsFirst] - Boolean [d:=False] si TRUE, Fait un Clear de ToSheet
 ' *** Déclaration ***
 ' ... Variables messages d'erreurs
 If FromSheet.Name = ToSheet.Name Then Exit Function
 Const ErrTitle As String = "Procédure - ExportTable":
 Dim ErrMsg As String: ErrMsg = "*** Sortie de procédure ***" & vbCrLf & vbCrLf
 '
 Dim c As Integer
 Dim rngTarget As Range, rngImport As Range
 Dim TargetRow As Long, depl As Integer
 Dim LabelTarget As Range, LabelImport As Range
 Dim AddressNew As String
 '
 If IsFirst And ToSheet.Range("A1").CurrentRegion.count <> 1 Then ToSheet.Cells.Clear
 '
 ' *** Assignation ***
 Set rngTarget = ToSheet.Range("A1").CurrentRegion
 Set rngImport = FromSheet.Range("A1").CurrentRegion
 ' ... 1ère ligne
 Set LabelTarget = rngTarget.Resize(1, rngTarget.Columns.count)
 Set LabelImport = rngImport.Resize(1, rngImport.Columns.count)
 With rngTarget: TargetRow = .Rows.count + Abs(.Rows.count > 1): End With
 With ToSheet
  AddressNew = .Range(.Cells(TargetRow, 1), .Cells(TargetRow + rngImport.Rows.count - 1, rngImport.Columns.count)).Address
 End With
 ' *** Start ***
 Select Case rngImport.Rows.count
  Case Is > 1
    depl = Abs((TargetRow > 1))
    Set rngImport = rngImport.Offset(depl).Resize(rngImport.Rows.count - depl)
    With rngImport
     Select Case True
        Case rngTarget.count = 1 ' Pas de 1ère ligne (Labels)
          .Copy ToSheet.Range("A" & TargetRow)
          If ValueOnly Then ToSheet.Range(AddressNew).Value = ToSheet.Range(AddressNew).Value
        Case LabelTarget.count = .Resize(1, .Columns.count).count
          ' Vérification si même nombre de colonne
          For c = 1 To LabelTarget.Columns.count
           If LabelTarget.Cells(1, c) <> LabelImport.Cells(1, c) Then
            ErrMsg = ErrMsg & vbCrLf & "Etiquette pas identique " _
               & LabelTarget.Cells(1, c) & "(" & FromSheet.Name & ")"
            MsgBox "Labels pas identique " & LabelTarget.Cells(1, c): Exit Function
           End If
          Next
          .Copy ToSheet.Range("A" & TargetRow)
          If ValueOnly Then ToSheet.Range(AddressNew).Value = ToSheet.Range(AddressNew).Value
       Case Else
        ' Debug.Print "Le titre " & FromSheet.Name & " a une taille différente": Exit Function
     End Select
    End With
 End Select
End Function
Sub t()
 ' Sheets(ActiveSheet.Name).Names("Print_Area").RefersToRange.Value
 Range("znTest").Select
 ' ThisWorkbook.Names("znTest").RefersToRange.Select
 Debug.Print Application.WorksheetFunction.Match("Stock-JAN", Range("znTest"), 0)
End Sub

**mikadoo57** · 05/01/2013, 18h46

Là, c'est du lourd pour mon niveau

Je ne saisi pas comment lier la fonction et la procédure. Je suis plutôt habitué à écrire un "coup complet" de Sub à End Sub !

**Philippe Tulliez** · 05/01/2013, 21h08

Bonsoir,

Et bien tout simplement, la procédure (que j'ai mis en exemple) appelle la fonction. Au même titre que quand tu écris A = Left("Toto",2) tu invoques une fonction.

**mikadoo57** · 05/01/2013, 22h06

Si j'ai bien compris, la procédure s'écrit dans la feuille et la fonction dans un module ?

**Philippe Tulliez** · 06/01/2013, 00h31

Bonsoir,

Voici un petit exemple d'une procédure qui fait appel à une fonction

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
Option Explicit
Const ExportName As String = "report"
Sub ReportDataAllSheets()
 Dim shtReport As Worksheet
 Dim WS As Worksheet
 Dim count As Integer, Num As Integer
 Dim txt As String
 Set shtReport = ThisWorkbook.Worksheets(ExportName) ' Nom à changer
 Application.ScreenUpdating = False
 txt = "Liste des feuilles" & vbCrLf
 For Each WS In ThisWorkbook.Worksheets
  txt = txt & vbCrLf & maFonction(WS)
 Next WS
 MsgBox txt
 Application.ScreenUpdating = True
End Sub
Function maFonction(laFeuille As Worksheet) As String
  maFonction = laFeuille.Name
End Function

**mikadoo57** · 06/01/2013, 00h44

Donc c'est l'inverse : la procédure est dans un module et fait appel à la fonction écrite dans la feuille ?
Tu sais, je suis un autodidacte dans le VBA (l'administration où je travaillais mettait en place le matos mais jamais les cours de formation qui allaient avec !) donc je n'utilise pas forcément les bon termes et les subtilités de la syntaxe m'échappent encore. Mais je suis serein, statistiquement, il me reste encore 27 ans à vivre donc je peux encore progresser

**Philippe Tulliez** · 06/01/2013, 10h09

Bonjour,
Une procédure peut être de deux types Sub ou Function et se trouve dans un module qui lui même se trouve dans un projet (Un classeur est un projet) et une procédure peut appeler une autre procédure.
Les feuilles et ThisWorkbook sont aussi des modules qui contiennent des procédures événementielles.
Rassure toi, je suis aussi un autodidacte.

Aperçu avant impression d'une plage non vide

Macros et VBA Excel

Discussions similaires

Partager

Partager