Impression d'une sélection avec condition

Version imprimable

Voir 40 message(s) de cette discussion en une page

17/01/2020, 11h24
wouairness

Impression d'une sélection avec condition

Bonjour Mesdames et Monsieur;

Depuis que j'ai découvert ce site je m'en lasse pas, les possibilités de excel sont infinie et impossible pour moi de tous les connaitres donc encore aujourd'hui je m'en remets a vous.

Ma problématique aujourd'hui est plutôt simple mais je ne possède pas les connaissances pour cela.

Explication:
Je possède Excel 2016, comprenant 7 feuilles (plus a l'avenir) certain lien existe entre elle. Sur la première de ces feuilles, la "TGRI" comprend environ 1200 lignes chacune destinée a un objet pour chaque, identifier par un code spéciale ex:12345-ABCDEF.

Dans la seconde feuille "FD" (Fiche départ) reprenant les tournées a effectuer pour c'est objets avec leur code spéciale (en gros c'est la carte grise de l'objets :lol:)

Problématique:
Je souhaiterais, que avec un bouton macro (si possible) le code imprime 1 page de la ligne complété (ou si possible sélectionner les colonnes) des code ce trouvant dans la feuille "fd" et "tgri".
Je simplifie : le code doit détecter les code identique entre les deux feuilles et imprimer seul concerné dans la feuille "tgri" avec les colonnes "en-tète" (et oui je complique les choses sinon c'est pas drôle 8O)

Merci pour déjà avoir lu mon texte et je l’espéré votre aide prochaine, bien évidement je peux répondre a toute vos questions sur l'utilisation du document ou la description de ma demande afin de vous aiguiller au mieux.
17/01/2020, 19h17
jerome.vaussenat

Salut,

Franchement, même en relisant à plusieurs reprise, c'est pas claire ton histoire ...

peux tu nous mettre un bout de fichier. Comme çà on verra les colonnes concernées (avec des données bidon).
Là, je suis incapable de savoir quelle est la feuille contenant les lignes à conservées, celle qui donne les colonnes correcte.

Aide nous à t'aider.

GG
20/01/2020, 08h33
wouairness

1 pièce(s) jointe(s)

Bonjour jerome.vaussenat.

Pour simplifier la chose je souhaite imprimer des lignes d'un tableau en fonction d'un autre tableau, c'est ligne ayant un code unique (code textuelle), le code serais détecter par la macro et enregistrera les lignes a imprimer. Si possible avec les lignes comprenant les en-tète (3 lignes).

Pièce jointe 532025

1 pièce(s) jointe(s)

bonjour ,
pourquoi ne pas filtrer ton tableau selon les ID qui se trouve sur la deuxième feuille , imprimer les cellules visible puis défiltrer
si ça t'arrange vous pouvez tester ça :

Code:

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
Sub filtreetimprimer()
Dim F1 As Worksheet
Dim F2 As Worksheet
Set F1 = Sheets("Sheet1")
Set F2 = Sheets("Feuil1")
Dim I As Long
 Application.ScreenUpdating = False
 With F1
I = .Cells(Rows.Count, 2).End(xlUp).Row
.Range("B5:E" & I).AutoFilter field:=1, Criteria1:=Array(F2.Cells(5, 2), F2.Cells(6, 2), F2.Cells(7, 2)), Operator:=xlFilterValues
Application.Dialogs(xlDialogPrinterSetup).Show 'Pour choisir l'imprimante
With ActiveSheet.PageSetup
    .PrintArea = ("B5:E" & I)
    .Zoom = False
    .FitToPagesTall = 1
    .FitToPagesWide = 1
End With
ActiveSheet.PrintOut copies:=1
If Not .AutoFilter Is Nothing Then
      If .FilterMode Then .ShowAllData
      .AutoFilter.Range.AutoFilter
    End If
End With
 Application.ScreenUpdating = True
End Sub

à tester avec prudence , c'est un code bricolé par un autodidacte :aie:
Bonne continuation

21/01/2020, 15h38
wouairness

Bonjour BENNASR;

Merci beaucoup pour ton code il est très intéressant seulement j'ai du mal a l'adapter a mon véritable classeur, pourrais tu m'expliquer les modif a faire? je l'es déjà testé mais il m'affiche mal ce que je souhaite (ex: seulement l’entête et pas le résultat). De plus après environ 10 test le code me fait un retour d'erreur au niveaux de "ActiveSheet.PrintOut". serait tu pourquoi?

Merci beaucoup pour t'on aide tout de même. ;)

Bonjour
Il se peux que tu appelle la procédure à partir d'un autre onglet, donc j'ai porter quelques modifications
- Bien vérifiez le noms des onglets
- si ton tableau commence à partir de B5 de l'onglet Sheet1
- Que les critère de ton filtre se trouvent en B5, B6 et B7
- Vous pouvez supprimer momentanément la parite de code qui imprime le tableau après filtre aisni que la partie de code qui annule les filtre et voir si le code fait bien le filtre selon les codes figurant en onglet "feuil1"
Faites ces vérification et dire ce que ça donne
Code:

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 Sub filtreetimprimer() Dim F1 As Worksheet Dim F2 As Worksheet Set F1 = Sheets("Sheet1") 'Nom onglet ou se trouve le tableau à filtrer Set F2 = Sheets("Feuil1") 'Nom onglet ou se trouve le tableau les ID à utiliser critères de filtre Dim I As Long Application.ScreenUpdating = False With F1 .Activate I = .Cells(Rows.Count, 2).End(xlUp).Row .Range("B5:E" & I).AutoFilter field:=1, Criteria1:=Array(F2.Cells(5, 2), F2.Cells(6, 2), F2.Cells(7, 2)), Operator:=xlFilterValues Application.Dialogs(xlDialogPrinterSetup).Show 'Pour choisir l'imprimante With .PageSetup .PrintArea = ("B5:E" & I) .Zoom = False .FitToPagesTall = 1 .FitToPagesWide = 1 End With F1.PrintOut copies:=1 ' ********************** enlever filtre If Not .AutoFilter Is Nothing Then If .FilterMode Then .ShowAllData .AutoFilter.Range.AutoFilter End If End With Application.ScreenUpdating = True End Sub

22/01/2020, 09h49
wouairness

2 pièce(s) jointe(s)

Bonjour Bennasar;

Je suis vraiment désolé mais ton code ne fonctionne pas (surement car je ne l'es pas utiliser correctement) afin de mieux t'expliquer la situation je te transmet des images du "TGRI" (la feuille des données a imprimer) et le "FD" (la feuille ou le code est a retrouver dans le TGRI).

Petite info que je propose comme tu peux le voir le TGRI comporte énormément de ligne et de colonne, serai t'il possible de sélectionner les colonnes a imprimer? afin d’agressivement sur la mise en page (ne pas avoir 10 ligne ou c'est écrit en tout petit).

Image du TGRI (information a récupéré et a imprimer):Pièce jointe 532638

Image du FD (liste de code (sdis) a détecter avec le TGRI): Pièce jointe 532642

Merci ;)
22/01/2020, 10h51
BENNASR

bonjour
quelle colonne vous voulez imprimer??

1 pièce(s) jointe(s)

J'ai essayer de reproduire ton fichier exemple selon ton dernier message et je propose ce qui suit :
Filtrer
Masquer colonne : dans mon code j'ai supposé masquer les colonne de M à W et de la colonne Y à la colonne BL : à adapter pour ton cas
Imprimer
Enlever filtre
afficher colonne masquer
code :

Code:

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
Sub filtreetimprimer()
Dim F1 As Worksheet
Dim F2 As Worksheet
Set F1 = Sheets("TGRI")
Set F2 = Sheets("FD")
Dim Lig As Long
 Application.ScreenUpdating = False
 
Lig = F1.Cells(Rows.Count, 4).End(xlUp).Row
 
  Set d = CreateObject("scripting.dictionary")
  d.CompareMode = vbTextCompare
 
  Dim liste As New Collection
   Dim i As Integer
   On Error Resume Next
   For Each cel In F2.Range("D28:D37")
    If F2.Cells(cel.Row, 4) <> "" Then
    liste.Add cel.Value, CStr(cel.Value)
    End If
   Next cel
 
  For Each c In liste: d(c) = "": Next c
F1.Range("D8:BL" & Lig).AutoFilter Field:=7, Criteria1:=d.keys, Operator:=xlFilterValues
 
F1.Range("M:W,Y:BL").EntireColumn.Hidden = True
 
Application.Dialogs(xlDialogPrinterSetup).Show 'Pour choisir l'imprimante
With F1.PageSetup
    .PrintArea = ("D8:BL" & Lig)
    .Zoom = False
    .FitToPagesTall = 1
    .FitToPagesWide = 1
End With
F1.PrintOut copies:=1
' ********************** enlever filtre
If Not F1.AutoFilter Is Nothing Then
      If F1.FilterMode Then F1.ShowAllData
      F1.AutoFilter.Range.AutoFilter
    End If
' afficher colonne
F1.Range("M:W,Y:BL").EntireColumn.Hidden = False
 Application.ScreenUpdating = True
End Sub

à tester avec prudence

22/01/2020, 14h31
wouairness

1 pièce(s) jointe(s)

Super je suis très content, ton code fonctionne bien seulement j'ai deux petit problèmes, je ne peux imprimer que 10 pages (10 lancement de code) et après l'impression ne s'effectue pas (j'ai la proposition du choix de l’imprimante)
Mon second problème est que le code m'affiche les 5 premier colonne (la partie signalement) et je ne les souhaite pas sur l'impression alors que je lui est demandé de commencer par la colonne "J".

Aurais tu une solution?

Pièce jointe 532768
22/01/2020, 14h48
BENNASR

si vous avez une imprimante par défaut vous n'avez pas besoin de choisir une imprimante supprimer cette partie de code

Code:

Application.Dialogs(xlDialogPrinterSetup).Show

dire quelle sont exactement les colonnes que vous voulez imprimer...à noter que cette parie de code sert à masquer les colonnes

Code:

F1.Range("M:W,Y:BL").EntireColumn.Hidden = True

on masque les colonne de M à W et les colonnes de Y à BL : donc à toi d'adapter pour ton cas

Citation:

(10 lancement de code)

pourquoi 10 fois ????
cette partie de code pour dire directement le nombre des copie à imprimer

Code:

F1.PrintOut copies:=1

si vous voulez plus d'une copie il suffit de remplacer le 1 par le nombre des copie que vous voulez imprimer

Bonjour BENNASAR;

Je me suis mal exprimer quand j'ai voulu dire 10 fois je parlais du nombre de lancement du code, je l'es lancé a plusieurs reprise pour le tester et bien le configurer mais âpres c'est 10 fois il me mets l’imprimante en défaut et la seule solution que j'ai c'est de redémarrer le pc pour pouvoir utiliser le code encore 10 fois. A savoir que cela n'est vraiment pas grave car j'utiliserai ce code seulement 1 fois tout les 5 jours ( donc le pc aura démarrer plusieurs fois ;) ).

Les colonnes a exclure sont : K:M,P:R,T:V,Z:AD,AJ:BC,BE:BH j'ai donc configurer le code comme suit :

Code:

F1.Range("K:M,P:R,T:V,Z:AD,AJ:BC,BE:BH").EntireColumn.Hidden = True

Le début de la zone d'impression est en "J8:BL" comme le montre le code:
Code:

1 2 3 4 5 6 With F1.PageSetup .PrintArea = ("J8:BL" & Lig) .Zoom = False .FitToPagesTall = 1 .FitToPagesWide = 1
.
Code:

1 2 3 4 5 6 7 8 Dim liste As New Collection Dim i As Integer On Error Resume Next For Each cel In F2.Range("D28:D37") If F2.Cells(cel.Row, 4) <> "" Then liste.Add cel.Value, CStr(cel.Value) End If Next cel
ps: en retirant le choix de l’imprimante l'impression ne s'effectue pas (même si le périphérique est bien par défaut)

Bonjour
il suffit simplement de masquer de D à I ce qui donne :

Code:

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
Sub filtreetimprimer()
Dim F1 As Worksheet
Dim F2 As Worksheet
Set F1 = Sheets("TGRI")
Set F2 = Sheets("FD")
Dim Lig As Long
 Application.ScreenUpdating = False
 
Lig = F1.Cells(Rows.Count, 4).End(xlUp).Row
 
  Set d = CreateObject("scripting.dictionary")
  d.CompareMode = vbTextCompare
 
  Dim liste As New Collection
   Dim i As Integer
   On Error Resume Next
   For Each cel In F2.Range("D28:D37")
    If F2.Cells(cel.Row, 4) <> "" Then
    liste.Add cel.Value, CStr(cel.Value)
    End If
   Next cel
 
  For Each c In liste: d(c) = "": Next c
F1.Range("D8:BL" & Lig).AutoFilter Field:=7, Criteria1:=d.keys, Operator:=xlFilterValues
 
F1.Range("D:I,K:M,P:R,T:V,Z:AD,AJ:BC,BE:BH").EntireColumn.Hidden = True
 
 
'Application.Dialogs(xlDialogPrinterSetup).Show 'Pour choisir l'imprimante
With F1.PageSetup
    .PrintArea = ("D8:BL" & Lig)
    .Zoom = False
    .FitToPagesTall = 1
    .FitToPagesWide = 1
End With
F1.PrintOut copies:=1
' ********************** enlever filtre
If Not F1.AutoFilter Is Nothing Then
      If F1.FilterMode Then F1.ShowAllData
      F1.AutoFilter.Range.AutoFilter
    End If
' afficher colonne
F1.Range("D:I,K:M,P:R,T:V,Z:AD,AJ:BC,BE:BH").EntireColumn.Hidden = False
 
 Application.ScreenUpdating = True
End Sub

tester et dire si ça te convient

23/01/2020, 09h11
wouairness

Super cela fonctionne avec ton code (mais pas avec le miens sa reste un mystère) la dernière chose que je souhaiterais faire c'est pour les en-tètes qu'il m'affiche la ligne 6,7,8. pourrais tu me dire comment faire?
23/01/2020, 09h19
BENNASR

peut être avec le changement de la zone d'impression

Code:

.PrintArea = ("D8:BL" & Lig)

par

Code:

.PrintArea = ("D6:BL" & Lig)
23/01/2020, 09h38
wouairness

Malheureusement il m'affiche que la ligne 6 et pas la 7 et 8. j'ai testé :

Code:

.PrintArea = ("D6:BL8" & Lig)

Code:

F1.Range("D6:BL8" & Lig).AutoFilter Field:=7, Criteria1:=d.keys, Operator:=xlFilterValues

mais il m'imprime 250 pages et j'ai aussi essayé:

Code:

.PrintArea = ("D6:BL,D7:BL,D8" & Lig)

Code:

F1.Range("D6:BL,D7:BL,D8" & Lig).AutoFilter Field:=7, Criteria1:=d.keys, Operator:=xlFilterValues

et tout deux ne fonctionne pas.
23/01/2020, 09h40
BENNASR

pourquoi le 8 avec BL ??

Code:

.PrintArea = ("D6:BL8" & Lig)

BL sans 8

Code:

.PrintArea = ("D6:BL" & Lig)
23/01/2020, 09h42
wouairness

Ta proposition a été la première que j'ai utilisé (avant celle que je t'es présenté) mais il m'affiche que la ligne 8.
23/01/2020, 09h44
BENNASR

ne pas ajouter 8 à BL si non la variable Lig qui est égale à la dernière ligne non vide n'a pas de sens

Je n'es pas rajouté de 0 après le BL ne t'en fait pas, je te communique le code si sa peut t'aider. ;)

Code:

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
Sub filtreetimprimer()
Dim F1 As Worksheet
Dim F2 As Worksheet
Set F1 = Sheets("TGRI")
Set F2 = Sheets("FD")
Dim Lig As Long
 Application.ScreenUpdating = False
 
Lig = F1.Cells(Rows.Count, 4).End(xlUp).Row
 
  Set d = CreateObject("scripting.dictionary")
  d.CompareMode = vbTextCompare
 
  Dim liste As New Collection
   Dim i As Integer
   On Error Resume Next
   For Each cel In F2.Range("D28:D37")
    If F2.Cells(cel.Row, 4) <> "" Then
    liste.Add cel.Value, CStr(cel.Value)
    End If
   Next cel
 
  For Each c In liste: d(c) = "": Next c
F1.Range("D6:BL" & Lig).AutoFilter Field:=7, Criteria1:=d.keys, Operator:=xlFilterValues
 
F1.Range("D:I,K:M,P:R,T:V,Z:AD,AJ:BC,BE:BH,BJ:BL").EntireColumn.Hidden = True
 
 
'Application.Dialogs(xlDialogPrinterSetup).Show 'Pour choisir l'imprimante
With F1.PageSetup
    .PrintArea = ("D6:BL" & Lig)
    .Zoom = False
    .FitToPagesTall = 1
    .FitToPagesWide = 1
End With
F1.PrintOut copies:=1
' ********************** enlever filtre
If Not F1.AutoFilter Is Nothing Then
      If F1.FilterMode Then F1.ShowAllData
      F1.AutoFilter.Range.AutoFilter
    End If
' afficher colonne
F1.Range("D:I,K:M,P:R,T:V,Z:AD,AJ:BC,BE:BH,BJ:BL").EntireColumn.Hidden = False
 
 Application.ScreenUpdating = True
End Sub

Voir 40 message(s) de cette discussion en une page