Sauvegarder un Excel en pdf avec nom compilé

Bonjour,

Regarde la méthode UNION dans VBA.

Pas beaucoup de temps à t'accorder ce jour.

En gros :

set rng1=Range("A2:B10")
set rng2=Range("C5:D20")
set rng3=Range("F4:G23")
set rngTemp=Union(rng1,rng2,rng3)

Puis tu détermines ta zone d'impression avec rngTemp.

Cdlt.

ok ne t inkiet pas je suis pas à la minute

en fait là ce qu il manque c est la formule de test jusqu a trouver une cellule vide de valeur (mais contenant une formule) exemple en francais:

tester si valeur dans b7=oui

tester valeur dans b8= oui

tester valeur dans b9=oui

tester valeur dans b1999=oui

tester valeur dans b2000=non

donc

set rng1=Range("A1:B1999")

ensuite on passe une autre colonne a tester

un ami m a ecrit ca:

Col = 2 ' colonne B

Ligne=7

Compteur1=0

Do

Valeur1 = cells(ligne, col).value

If valeur1 <> "" then

Compteur1 = compteur1 + 1

End if

Loop While valeur <> ""

memorisation du numero de ligne (compteur je supose)

set rng1=Range("A1:h(numero de ligne memorisé)")

mais ne voit pas comment bien ecrire la fin

Bonjour,

Une nouvelle proposition à étudier et à tester.

Cdlt.

Option Explicit

Public Sub SaveAsPDF()
Dim wb As Workbook
Dim sPath As String, sFilename As String
Dim lRow As Long, J As Long
Dim rng As Range, Urng As Range

    Application.ScreenUpdating = False
    Set wb = ThisWorkbook
    'sPath = "C:\Users\labo\Desktop\logiciel controle de poid version bureau\pdf\"
    sPath = wb.Path & Application.PathSeparator

    With wb.Worksheets("recap")
        .Range("J3").Value = Range("E5").Value  '???
        sFilename = .Range("J3") & ".pdf"       '???
        'sFilename = "TEST JEP.pdf"
        Set rng = .Range("A1:G97")
        .PageSetup.PrintArea = rng.Address
    End With

    With wb.Worksheets("données")
        .PageSetup.PrintArea = False
        For J = 2 To 26 Step 8
            'Debug.Print "colonne : " & J
            If .Cells(3, J) > 0 Then
                lRow = .Cells(Rows.Count, J).End(xlUp).Row
                Set rng = .Range(.Cells(1, J), .Cells(lRow, J + 6))
                If Urng Is Nothing Then
                    Set Urng = rng
                    'Debug.Print Urng.Address
                Else
                    Set Urng = Union(Urng, rng)
                    'Debug.Print Urng.Address
                End If
            End If
            Set rng = Nothing
        Next J
        .PageSetup.PrintArea = Urng.Address
    End With

    wb.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=sPath & sFilename, _
            Quality:=xlQualityMinimum, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False

    Set Urng = Nothing
    Set wb = Nothing

End Sub

salut jean eric que pense tu de celle là:

Public Sub SaveAsPDF()

Dim wb As Workbook

Dim sPath As String, sFilename As String

Dim lRow As Long, lRow2 As Long

Application.ScreenUpdating = False

Set wb = ThisWorkbook

sPath = "C:\Users\labo\Desktop\logiciel controle de poid version bureau\pdf\"

'sPath = wb.Path & Application.PathSeparator

With wb.Worksheets("recap")

.Range("J3").Value = Range("E5").Value

sFilename = .Range("J3") & ".pdf"

Set rng = .Range("A1:G97")

.PageSetup.PrintArea = rng.Address

.PrintOut Copies:=1

End With

With wb.Worksheets("données")

lRow = .Cells(Rows.Count, 2).End(xlUp).Row

For J = 10 To 26 Step 8

lRow2 = .Cells(Rows.Count, J).End(xlUp).Row

If lRow2 > lRow Then lRow = lRow2

Next J

Set rng = .Range(.Cells(1), .Cells(lRow, 48))

.PageSetup.PrintArea = rng.Address

End With

wb.ExportAsFixedFormat _

Type:=xlTypePDF, _

Filename:=sPath & sFilename, _

Quality:=xlQualityMinimum, _

IncludeDocProperties:=True, _

IgnorePrintAreas:=False, _

OpenAfterPublish:=False

Set rng = Nothing

Set wb = Nothing

ActiveWindow.ScrollRow = 1

ActiveWorkbook.Save

End Sub

Public Sub SaveAsPDF3()

Dim wb As Workbook

Dim sPath As String, sFilename As String

Dim lRow As Long, lRow2 As Long

Application.ScreenUpdating = False

Set wb = ThisWorkbook

sPath = "C:\Users\labo\Desktop\logiciel controle de poid version bureau\pdf\"

'sPath = wb.Path & Application.PathSeparator

With wb.Worksheets("recap")

.Range("J3").Value = Range("E5").Value

sFilename = .Range("J3") & ".pdf"

Set rng = .Range("A1:G97")

.PageSetup.PrintArea = rng.Address

'.PrintOut Copies:=1

End With

With wb.Worksheets("données")

col = 2 ' colonne B

colstart = col - 1

colend = col + 6

ligne = 7

compteur1 = 0

Do

valeur1 = Cells(ligne, col).Value

If valeur1 <> "" Then

compteur1 = compteur1 + 1

End If

Loop While valeur <> ""

Set rng1 = .Range(.Cells(colstart, 1), .Cells(colend, compteur1))

col2 = 10

colstart2 = col2 - 1

colend2 = col2 + 6

ligne = 7

compteur2 = 0

Do

valeur2 = Cells(ligne, col).Value

If valeur2 <> "" Then

compteur2 = compteur2 + 1

End If

Loop While valeur2 <> ""

Set rng2 = .Range(.Cells(colstart2, 1), .Cells(colend2, compteur2))

.PageSetup.PrintArea = Urng.Address

col3 = 18

colstart3 = col3 - 1

colend3 = col3 + 6

ligne = 7

compteur3 = 0

Do

valeur3 = Cells(ligne, col).Value

If valeur3 <> "" Then

compteur3 = compteur3 + 1

End If

Loop While valeur3 <> ""

Set rng3 = .Range(.Cells(colstart3, 1), .Cells(colend3, compteur2))

col4 = 26

colstart4 = col4 - 1

colend4 = col4 + 6

ligne = 7

compteur4 = 0

Do

valeur4 = Cells(ligne, col).Value

If valeur4 <> "" Then

compteur4 = compteur4 + 1

End If

Loop While valeur4 <> ""

Set rng4 = .Range(.Cells(colstart4, 1), .Cells(colend4, compteur4))

Set Urng = Union(rng1, rng2, rng3, rng4)

End With

wb.ExportAsFixedFormat _

Type:=xlTypePDF, _

Filename:=sPath & sFilename, _

Quality:=xlQualityMinimum, _

IncludeDocProperties:=True, _

IgnorePrintAreas:=False, _

OpenAfterPublish:=False

Set rng = Nothing

Set wb = Nothing

ActiveWindow.ScrollRow = 1

ActiveWorkbook.Save

End Sub

c est juste que cher moi elle tourne en rond... est elle ecrite proprement?

Re,

As-tu essayé ma nouvelle proposition?

Quel est le résultat?

Cdlt.

je vais te mettre le pdf en ligne pour te montrer

a priori ca marche impeccable, au debut je pensais que ca ne marchais pas donc j ai essayé une autre methode

et en reessayant c etait bon merci beaucoup, c est tip top

salut j'ai une erreur qui apparait depuis aujourd hui

Sub SaveAsPDF2()

Dim wb As Workbook

Dim sPath As String, sFilename As String

Dim lRow As Long, J As Long

Dim rng As Range, Urng As Range

Application.ScreenUpdating = False

Set wb = ThisWorkbook

'sPath = "C:\Users\labo\Desktop\logiciel controle de poid version bureau\pdf\"

sPath = wb.Path & Application.PathSeparator & "pdf\"

With wb.Worksheets("recap")

.Range("J3").Value = Range("E5").Value

sFilename = .Range("J3") & ".pdf"

Set rng = .Range("A1:G97")

.PageSetup.PrintArea = rng.Address

.PrintOut Copies:=1

End With

With wb.Worksheets("données")

.PageSetup.PrintArea = False

For J = 2 To 26 Step 8

If .Cells(3, J) > 0 Then

lRow = .Cells(Rows.Count, J).End(xlUp).Row

Set rng = .Range(.Cells(1, J), .Cells(lRow, J + 6))

If Urng Is Nothing Then

Set Urng = rng

Else

Set Urng = Union(Urng, rng)

End If

End If

Set rng = Nothing

Next J

.PageSetup.PrintArea = Urng.Address

End With

wb.ExportAsFixedFormat _

Type:=xlTypePDF, _

FileName:=sPath & sFilename, _

Quality:=xlQualityMinimum, _

IncludeDocProperties:=True, _

IgnorePrintAreas:=False, _

OpenAfterPublish:=False

Set Urng = Nothing

Set wb = Nothing

ActiveWorkbook.Save

Application.ScreenUpdating = True

ActiveWindow.ScrollRow = 1

End Sub

erreur d execution 91

Bonjour,

Ce message d'erreur t'indique que tu veux utiliser une variable objet (Urng) ayant 'Nothing' pour valeur.

Dans l'éditeur VBE, Fais Ctrl+G. La fenêtre d'exécution va s'ouvrir.

Tu ajoutes les codes surlignés à ta procédure. Puis tu exécutes ta procédure.

A te relire.

For J = 2 To 26 Step 8
            If .Cells(3, J) > 0 Then
                lRow = .Cells(Rows.Count, J).End(xlUp).Row
                Set rng = .Range(.Cells(1, J), .Cells(lRow, J + 6))
                If Urng Is Nothing Then
                    Set Urng = rng
                    Debug.Print " rng = " & rng.Address
                Else
                    Set Urng = Union(Urng, rng)
                   Debug.Print "Urng = " & Urng.Address
                End If
            End If
            Set rng = Nothing
        Next J

alors en fait de ce que j ai compris

j'ai fais des essais d impression avec une zone de selection vide, et ça ne lui aurait pas plus

donc je vais rajouter une condition au cas ou