Enregistrer en txt puis en pdf

Le 01/12/2022 à 17:44

Bonjour à tous,

J'aurai besoin d'aide, j'ai plusieurs feuilles d'un classeur à enregistrer sous différents formats et dans divers emplacements.

Le fichier en PJ.

Alors, sur la feuille 3, je voudrai un gros bouton à droite avec marqué "enregistrer le Txt et le PDF" et sa enregistrerai les 2 :)

Le VBA :

Il faut qu'il enregistre la feuille "Tunnel Rectangle" sous format .txt avec comme nom de fichier les valeurs des cellules suivantes : "B3-B6" (de la feuille "Tunnel Rectangle") il me faut le petit tiret entre les 2 svp :D et qu'il enregistre ce txt à cet emplacement : Bureau\GEIE TMB\Txt

Ensuite, qu'il enregistre la feuille 3 en .PDF avec comme nom de fichier les valeurs des cellules suivantes : "C40_G13_G16" (de la feuille3) il me faut les petits tirets entre les 3 svp :D et qu'il enregistre ce pdf à cet emplacement : Bureau\GEIE TMB\Expertises

Pour le chemin, "Bureau" c'est bien le bureau d'accueil de nos pc ;)

Merci d'avance vous êtes top sa va grandement nous faciliter la vie!

7tunnel-rectangle-forum.xlsm (87.74 Ko)
Le 01/12/2022 à 20:42

Pour les PDF, s'agit-il de tirets du 6 ou d'underscores ?

Quel est le chemin réel du Bureau (l'utilisateur) ?

Le 01/12/2022 à 20:48

Bonjour Lasgalen, salut Optimix et le Forum,

voici ma proposition

Sub Button1_Click()

Dim CheminTxt As String, CheminPdf As String, MonFichier As String
Dim shTunRec As Worksheet

Set shTunRec = ThisWorkbook.Sheets("Tunnel Rectangle")

CheminTxt = "Bureau\GEIE TMB\Txt\"

CheminPdf = "Bureau\GEIE TMB\Expertises\"
MonFichier = Range("C40") & "_" & Range("G13") & "_" & Range("G16") & ".pdf"

Application.ScreenUpdating = False

shTunRec.Copy

With ActiveWorkbook
    .SaveAs Filename:=CheminTxt & shTunRec.Range("B3") & "-" _
    & shTunRec.Range("B6") & ".txt", FileFormat:=xlTextWindows
    .Close
End With

ActiveSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=CheminPdf & MonFichier, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False

End Sub
Le 02/12/2022 à 06:53

Bonjour tout le monde,
Bon, en l'absence de réponse à mes questions :
- j'ai pris l'utilisateur "Michel", tu mettras celui que l'administrateur t'a donné pour des raisons de sécurité ;
- j'ai considéré que tu voulais utiliser des tirets comme pour le nom du fichier PDF et non pas des underscores.

Proposition :

Sub record()
    Dim chemin1 As String, chemin2 As String, fichier1 As String, fichier2 As String
    Dim wS1 As Worksheet, wS2 As Worksheet

    On Error GoTo GESTERREUR

    Set wS1 = Sheets("tunnel-rectangle-forum")
    Set wS2 = Sheets("Feuil3")

    chemin1 = "C:\Users\Michel\Desktop\GEIE TMB\Txt\"
    chemin2 = "C:\Users\Michel\Desktop\GEIE TMB\Expertises\"
    fichier1 = wS1.Cells(3, 2) & "-" & wS1.Cells(6, 2) & ".txt"
    fichier2 = wS2.Cells(40, 3) & "-" & wS2.Cells(13, 7) & "-" & wS2.Cells(16, 7) & ".pdf"

    ' TXT
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=chemin1 & fichier1, FileFormat:=xlUnicodeText, CreateBackup:=False
    ActiveWorkbook.Close savechanges:=False

    ' PDF
    ActiveSheet.Copy
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin2 & fichier2, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ActiveWorkbook.Close savechanges:=False

    MsgBox "Sauvegardes effectuées", vbInformation + vbOKOnly, "Exportation"
    Exit Sub

GESTERREUR:
    MsgBox Err.Description & "-" & Err.Number
End Sub
Le 02/12/2022 à 09:01

Bonjour à tous, merci de vos réponses,

C'est la ou sa peut poser problème, nous allons être 2 à utiliser ce fichier sur 2 pc différents donc l'utilisateur va changer...

Vous avez une solution avec cette problématique?

Pour les tirets il s'agit bien du tiret du 6 "-" pour le txt et du tiret du 8"_" pour le PDF.

Otpimix, sur ton code si on prend que ca : "Desktop\GEIE TMB\Txt\" sa va passer non?

Le 02/12/2022 à 10:09

Non, ça ne marchera pas. Il te suffit d'essayer en changeant les chemins. Entre nous, le bureau n'est pas fait pour cela.
Le mieux est de créer (chacun chez soi) un dossier de stockage sur le lecteur principal (c:\ par exemple).

Dans le code ci-dessous, si le dossier C:\Test n'existe pas, il est créé avec les sous et sous-sous-dossiers qui vont bien. La macro placera les fichiers texte et pdf aux bons endroits.

Sub record()
    Dim chemin1 As String, chemin2 As String, fichier1 As String, fichier2 As String
    Dim wS1 As Worksheet, wS2 As Worksheet

    On Error GoTo GESTERREUR

    Set wS1 = Sheets("tunnel-rectangle-forum")
    Set wS2 = Sheets("Feuil3")
    If Dir("c:\Test") = "" Then
        MkDir "c:\Test"
        MkDir "C:\Test\GEIE TMB"
        MkDir "C:\Test\GEIE TMB\Txt"
        MkDir "C:\Test\GEIE TMB\Expertises"
    End If
    chemin1 = "C:\Test\GEIE TMB\Txt\"
    chemin2 = "C:\Test\GEIE TMB\Expertises\"
    fichier1 = wS1.Cells(3, 2) & "-" & wS1.Cells(6, 2) & ".txt"
    fichier2 = wS2.Cells(40, 3) & "_" & wS2.Cells(13, 7) & "_" & wS2.Cells(16, 7) & ".pdf"

    ' TXT
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=chemin1 & fichier1, FileFormat:=xlUnicodeText, CreateBackup:=False
    ActiveWorkbook.Close savechanges:=False

    ' PDF
    ActiveSheet.Copy
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin2 & fichier2, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ActiveWorkbook.Close savechanges:=False

    MsgBox "Sauvegardes effectuées", vbInformation + vbOKOnly, "Exportation"
    Exit Sub

GESTERREUR:
    MsgBox Err.Description & "-" & Err.Number
End Sub
Le 02/12/2022 à 10:28

Super merci je vais essayer je te tiens au jus!

Merci pour tes réponses rapides et constructives !

Le 02/12/2022 à 17:50

Hello,

Alors message d'erreur :

image

Le code que j'ai "modifié" j'ai remis le bon nom de la feuille et le chemin exacte

Le chemin d'accès aux fichiers directement fait sur mon C :

C:\Client\GEIE TMB\Expertises

C:\Client\GEIE TMB\Txt

Sub Enregistrement()

    Dim chemin1 As String, chemin2 As String, fichier1 As String, fichier2 As String
    Dim wS1 As Worksheet, wS2 As Worksheet

    On Error GoTo GESTERREUR

    Set wS1 = Sheets("Tunnel Rectangle")
    Set wS2 = Sheets("Feuil3")
    If Dir("C:\Client") = "" Then
        MkDir "c:\Client"
        MkDir "C:\Client\GEIE TMB"
        MkDir "C:\Client\GEIE TMB\Txt"
        MkDir "C:\Client\GEIE TMB\Expertises"
    End If
    chemin1 = "C:\Client\GEIE TMB\Txt\"
    chemin2 = "C:\Client\GEIE TMB\Expertises\"
    fichier1 = wS1.Cells(3, 2) & "-" & wS1.Cells(6, 2) & ".txt"
    fichier2 = wS2.Cells(40, 3) & "_" & wS2.Cells(13, 7) & "_" & wS2.Cells(16, 7) & ".pdf"

    ' TXT
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=chemin1 & fichier1, FileFormat:=xlUnicodeText, CreateBackup:=False
    ActiveWorkbook.Close savechanges:=False

    ' PDF
    ActiveSheet.Copy
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin2 & fichier2, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    ActiveWorkbook.Close savechanges:=False

    MsgBox "Sauvegardes effectuées", vbInformation + vbOKOnly, "Exportation"
    Exit Sub

GESTERREUR:
    MsgBox Err.Description & "-" & Err.Number
End Sub
Le 02/12/2022 à 18:40

Chez moi, pas d'erreur. J'ai remplacé mon code par le tien, renommé la feuille "Tunnel Rectangle", mes fichiers s'enregistrent normalement.

Le dossier C:\Client et ses sous-dossiers ont bien toutes les autorisations ? Si c'est le cas, il faudrait que tu débogues ce code pas à pas sur ton ordi.

Le 05/12/2022 à 08:20

Hello,

Je ne comprend pas d'où vient le problème...

Le 05/12/2022 à 11:43

La fonction dir() nécessite un paramètre, les autres sont en option. Essaye ceci :

If Dir("C:\Client", vbDirectory) = "" Then au lieu de If Dir("C:\Client") = "" Then

Le 05/12/2022 à 17:26

YEs !!!!!! merci sa fonctionne super bien !

Rechercher des sujets similaires à "enregistrer txt puis pdf"