Discussion :

[lps02]

Bonsoir les maitre du vba

J'ai encore besoin de vos lumieres: Mon probleme est le suivant
je genere sous pdf certaines feuilles d'un classeur (feuille nommées "lot "et n°).
grâce au tutoriels, j'ai réussi à le faire. Mais en fait, je m'aperçois que ces tableaux qui sont tous faits de la même façon ne prennent qu'une demi page. Aussi, je souhaiterai que si l'index du lot est pair alors le tableau vienne se mettre sous le lot impair avant l'impression sous pdf. en fait, je voudrais deux lot par page un lot impair et un lot pair. Je pense à if mod 2=0 then le tableau vient se mettre sous le numéro impair avant impression.Par contre cette "fusion " ne concerne que l'impression sous VBA. Chaque onglet doit rester.

Est ce possible et pouvez vous m'aider?

Le tableau est toujours sur la plage B2 à L27 de chaque onglet.

Cordialement
lps02

Le code que j'ai pour le pdf

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
Sub impression_cahier()
Dim sNomFichierPDF As String
Dim i As Long, Cpt As Long
Dim Ar() As String
 
    sNomFichierPDF = ThisWorkbook.Path & "\" & "cahier2012.pdf"
 
    Cpt = 0
    For i = 1 To ThisWorkbook.Sheets.Count
        If Left(Sheets(i).Name, 4) = "lot " Then
            ReDim Preserve Ar(Cpt)
            Ar(Cpt) = Sheets(i).Name
            Cpt = Cpt + 1
        End If
    Next i
    If Cpt = 0 Then Exit Sub
 
    Application.ScreenUpdating = False
    Sheets(Ar).Select
 
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sNomFichierPDF _
        , Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=True
 
    Sheets("Feuil1").Select
    Application.ScreenUpdating = True
End Sub

[kiki29]

Salut, utilise une feuille intermédiaire, visible ou pas, pour faire ce genre de regroupement avant de générer le Pdf.

[lps02]

Bonsoir Philippe

C'est ce que je pensai faire. je pensai qu'il y avait plus simple.

Qu'entends tu par visible ou pas?,

Cordialement

lps02

[lps02]

Bonjour les maîtres du vba

Fort de vos precieux conseils, j'ai créé le code suivant qui regroupe deux onglets en un avant impression en pdf.

Il fonctionne mais :
1)Lorsque le nombre de lot est impair, il ne me génère pas de pdf pour le lot qui reste
2) il me genere un pdf por chaque regroupement alors que je voudrai un unique pdf (comme dans le code donné par kiki29) (voir mon premier message.

Je bloque donc sur ces deux soucis. Pouvez vous m'aider??

Cordialement

lps02

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
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
71
72
73
74
Sub meme_chose()
Dim a As Long
Dim sNomFichierPDF As String
Dim i As Long, Cpt As Long
Dim Ar() As String, c As String
 
 
For a = 1 To ThisWorkbook.Sheets.Count
 
If Left(Sheets(a).Name, 4) = "lot " Then
b = CInt(Right(Sheets(a).Name, Len(Sheets(a).Name) - 4))
        If b Mod 2 <> 0 Then
Sheets("lot " & b).Range("B2:L27").Copy
        With Sheets("Feuil2")
    .Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    .Range("B2").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        End With
Else
 Sheets("lot " & b).Range("B2:L27").Copy
     With Sheets("Feuil2")
    .Range("B35").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    .Range("B35").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        End With
 
 
        With Sheets("Feuil2")
    .PageSetup.PrintArea = "$B$2:$L$60"
    .PageSetup.Zoom = False
    .PageSetup.FitToPagesTall = 1
    .PageSetup.FitToPagesWide = 1
   sNomFichierPDF = ThisWorkbook.Path & "\" & "lot " & .Range("E2").Value & "et" & .Range("E35").Value & ".pdf"
    c = .Range("E2").Value & "et" & .Range("E35").Value
    .Name = "mise en page " & c
        End With
 
 
 
 
 
   Cpt = 0
    For i = 1 To ThisWorkbook.Sheets.Count
        If Left(Sheets(i).Name, 13) = "mise en page " Then
            ReDim Preserve Ar(Cpt)
            Ar(Cpt) = Sheets(i).Name
            Cpt = Cpt + 1
        End If
    Next i
    If Cpt = 0 Then Exit Sub
 
    Application.ScreenUpdating = False
    Sheets(Ar).Select
 
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sNomFichierPDF _
        , Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=True
 
       Application.CutCopyMode = False
 
  Sheets("mise en page " & c).Name = "Feuil2"
 
        Sheets("Feuil2").Range("B2:L60").Clear
End If
  End If
  Next a
 
 
    Sheets("ACCUEIL").Select
    Application.ScreenUpdating = True
 
End Sub