XL 2016 Comment Traduire ces instructions en vba

[dindin]

Bonjour
Comment peut-on traduire ces instructions en vba
Convertir la feuille Excel actuelle en format pdf
Sous le nom xxxxxxx
Au même chemin ou se trouve mon fichier actuel c'est à dire le fichier excel actuel dans un dossier au nom de permis travaux .
Si tu ne trouve pas ce dossier ajoute un nouveau dossier au mêmes nom et enregistre la feuille actuelle dedans.
Merci d'avance

 

[Nairolf]

Salut,

Regarde sur ce fil, tu auras un début de réponse dans les solutions proposées :
https://www.excel-downloads.com/threads/enregistrement-en-pdf.20048147/#post-20354178

 

[job75]

Bonjour dindin, Nairolf,

Exécutez cette macro :

Sub PDF()
Dim chemin$
chemin = ThisWorkbook.Path & "\permis travaux\"
If Dir(chemin, vbDirectory) = "" Then MkDir chemin 'crée le sous-dossier s'il n'existe pas
ActiveSheet.ExportAsFixedFormat xlTypePDF, chemin & "xxxxxxx" 'adapter le nom
End Sub

A+

 

[dindin]

Merci tout le monde
voici le fil pour celui qui en aura besoin un jour et cela fonctionne très bien pour moi
https://excel-malin.com/codes-sources-vba/creation-dossiers-et-sous-dossiers-en-vba/

on aura besoin de 2 Funtions
Tout d'abord on vérifie si le dossier existe ou non

Public Function DossierExiste(MonDossier As String)
'par Excel-Malin.com ( https://excel-malin.com )

   If Len(Dir(MonDossier, vbDirectory)) > 0 Then
      DossierExiste = True
   Else
      DossierExiste = False
   End If
End Function

2 s'il n'existe pas on crée un dossier et un sous dossier

Function CreerDossier(Chemin As String)
'par: Excel-Malin.com ( https://excel-malin.com )
    On Error GoTo CreerDossierErreur

Dim PremierDossier As String
Dim CheminReseau As Boolean
Dim CheminPartielOK As String
Dim CheminPartiel, PartieDeChemin As Integer
Dim PartiesDeChemin As Variant

Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")

If Len(Dir(Chemin, vbDirectory)) > 0 Then
CreerDossier = True
Exit Function
Else
        'suppression du dernier backslash si présent
        If Right(Chemin, 1) = Application.PathSeparator Then Chemin = Left(Chemin, Len(Chemin) - 1)
       
        'vérificacion si chemin local ou réseau
        If Left(Chemin, 2) = "\\" Then
            CheminReseau = True
        Else
            CheminReseau = False
        End If
       
        'décomposition du chemin
        If CheminReseau = False Then
            PartiesDeChemin = Split(Chemin, Application.PathSeparator)
            CheminPartielOK = ""
            PremierDossier = LBound(PartiesDeChemin)
        Else
            PartiesDeChemin = Split(Replace(Chemin, "\\", ""), Application.PathSeparator)
            CheminPartielOK = ""
            PremierDossier = LBound(PartiesDeChemin) + 1
        End If
   
    'tests et créations de (sous)dossiers
        For PartieDeChemin = PremierDossier To UBound(PartiesDeChemin)

            For CheminPartiel = LBound(PartiesDeChemin) To PartieDeChemin
           
                        If CheminReseau = False Then
                            CheminPartielOK = CheminPartielOK & PartiesDeChemin(CheminPartiel) & Application.PathSeparator
                        Else
                            CheminPartielOK = CheminPartielOK & PartiesDeChemin(CheminPartiel) & Application.PathSeparator
                        End If

                If CheminPartiel = PartieDeChemin Then
                        If CheminReseau = False Then
                                    If FSO.FolderExists(CheminPartielOK) = False Then
                                            MkDir CheminPartielOK
                                    End If
                        Else
                                    If Right(CheminPartielOK, 1) = Application.PathSeparator Then _
                                    CheminPartielOK = Left(CheminPartielOK, Len(CheminPartielOK) - 1)
                                   
                                    If Left(CheminPartielOK, 2) <> "\\" Then _
                                    CheminPartielOK = "\\" & CheminPartielOK
                                   
                                    If FSO.FolderExists(CheminPartielOK) = False Then
                                            MkDir CheminPartielOK
                                    End If
                        End If
                End If
            Next CheminPartiel
            CheminPartielOK = ""
        Next PartieDeChemin
End If

CreerDossier = True
Exit Function
CreerDossierErreur:
CreerDossier = False
End Function

voici le code de mon bouton

Private Sub pdf_dm_Click()
Dim fName As String
Dim MonDossier As String
'Dim x As String
'x = ActiveSheet.Name
With Worksheets("DM")
    fName = .Range("A21").Value & " _ " & .Range("G10").Value
    'fName = x & " _ " & ActiveSheet.Range("M11").Value
End With
'ChDir "H:\pol\dossiers partagés\4 AS et communication\4 AS\Applications\PS"
'récuperer le chemein du dossier source
ChDir ThisWorkbook.Path
MonDossier = ThisWorkbook.Path & "\" & "2020" & "\" & "permis_déménagement"

    If DossierExiste(MonDossier) = True Then
     

'enregistrer le pdf dans le même dossier que le fichier source

'ThisWorkbook.Path & "\" & "2020" & "\" & "permis_déménagement" & "\" & fName, Quality:=
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
MonDossier & "\" & fName, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'afficher message à la fin d'enregistrement du PDF
'MsgBox ("Le permis : " & fName & " a été bien enregistré en PDF dans : " & ThisWorkbook.Path & vbLf & "Vous pouvez joindre ce fichier par mail.")
MsgBox ("Le permis : " & fName & " a été bien enregistré en PDF dans : " & MonDossier & vbLf & "Vous pouvez joindre ce fichier par mail.")
'enregistrer le classeur
ActiveWorkbook.Save

Else
      On Error GoTo ExempleErreur

Dim NouveauDossierAvecSousDossiers As String
    NouveauDossierAvecSousDossiers = ThisWorkbook.Path & "\" & "2020" & "\" & "permis_déménagement"
    CreerDossier (NouveauDossierAvecSousDossiers)
Exit Sub
ExempleErreur:
    MsgBox "Une erreur est survenue..."
    End If


End Sub

je n'ai pas compris très bien les 2 fonctions mais j'ai réussi à les adapter
je suis vraiment un novice
je remercie tout le monde