Code VBA pour impimer des onglets suivant valeurs cellules
Bonjour,
je configure un VBA pour imprimer des onglets défini par des cellules, et quand je fais le test, il me mets une erreur de débogage sur la ligne suivante.
Mon besoin, est de sortir ces onglets avec une quantité 1 dans ces cellules et de les imprimer en PDF puis de les envoyer par mail.
Sub SauverEnPDF()
' Un exemple de sauvegarde des onglets sélectionnés en PDF
Dim vararray() As String ' Afin de conserver les noms des onglets sélectionnés
Dim csname As Integer ' Colonne où se trouve le nom des onglets
Dim c As Integer ' Colonne où se trouve les choix 1 ou 0
Dim countarr As Integer ' Pour compter le nombre d'onglets sélectionnés
Dim r As Integer ' Pour compter à travers tous les onglets
Dim sname As Worksheet ' Nom de l'onglet de départ, pour y revenir à la fin
Dim strFileName As String ' Nom du fichier à sauvegarder
'set up location and counter variables
csname = Worksheets("Page Bouton").Range("U12").Column
c = Range("Z12").Column
Set sname = ActiveSheet
r = Range("Z12").Row
countarr = 0
' Boucle dans la iste des onglets tant qu'il y a un nom d'onglet
While sname.Cells(r, csname) <> ""
' Ajouter le nom de l'onglet à la liste si le choix est 1
If sname.Cells(r, c) = 1 Then
ReDim Preserve vararray(countarr)
' Un ReDim Preserve permet d'augmenter la taille de la variable tout en préservant son contenu
vararray(countarr) = sname.Cells(r, csname).Value
countarr = countarr + 1
End If
r = r + 1
Wend
' On sélection ensuite le groupe d'onglets sélectionnés
Sheets(vararray).Select
strFileName = Application.GetSaveAsFilename(filefilter:="PDF Files (*.pdf), *.pdf", Title:="RDC" & " " & "de" & " " & Worksheets("Fiche Renseignement").Range("E15") & " " & Worksheets("Fiche Renseignement").Range("C18") & " " & Worksheets("Fiche Renseignement").Range("G18") & " " & "Client_N°" & " " & Worksheets("Fiche Renseignement").Range("B15") & ".pdf")
' Il faut s'assurer que l'usager a bel et bien fait un choix.
' Sinon, le nom du fichier sera false ou faux, si Excel français
If strFileName <> "False" And strFileName <> "Faux" Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
' Ici, on va sauvegarder en fonction de la mise en page pour impression
End If
' On sort en revenant à l'onglet de départ
sname.Select
Set sname = Nothing
End Sub
Est ce que quelqu'un pourrais m'aider?
cordialement
Personne pour m'aider s'il vous plait.
car je doit rendre le fichier lundi et je rame depuis 3 jours.
merci d avance