Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 Comment Traduire ces instructions en vba

dindin

XLDnaute Occasionnel
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
 

job75

XLDnaute Barbatruc
Bonjour dindin, Nairolf,

Exécutez cette macro :
VB:
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

XLDnaute Occasionnel
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

VB:
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

Code:
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

Code:
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
 

Discussions similaires

Réponses
2
Affichages
294
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…