XL 2016 Enregistrement de plusieurs PDF + Excel dans le même dossier

[Lord sirc]

Bonjour à tous,

Je suis à la recherche d'une macro pour enregistrer un PDF et une copie en Excel.xls dans le même répertoire, le problème c'est que le répertoire est à définir par l'utilisateur.

Pour info j'ai créé 2 commandes, une pour le PDF et une pour Excel qui m'ouvre touts les deux un répertoire dans lequel je choisi le dossier mais finalement les 2 vont même endroit.

Je pensais laisser ma première "Application.GetSaveAsFilename" pour le PDF et récupérer le chemin du répertoire sélectionné pour enregistrer mon excel directement sans ouvrir de nouveau le répertoire.

D'avance merci de votre retour qui est toujours très rapide ; )

 

[_Thierry]

Bonjour @Lord sirc , le Forum

Ce devrait fonctionner en lisant l'aide Microsoft

Application.GetSaveAsFilename method (Excel)

Office VBA reference topic

docs.microsoft.com

En testant selon leur exemple on récupère la string complète

At toi ensuite de savoir changer l'extention pour le second file à sauver...
(Ou de savoir récupérer le Path style jusqu'au Ubound de MyPath = Split(fileSaveName, "\")...)

Bien à toi, à vous
@+Thierry

 

[_Thierry]

Re Bonsoir @Lord sirc , le Forum

Je n'ai jamais eu besoin de ce GetSaveAsFilename, du coup j'ai un peu approfondi son usage, car il ne sert PAS à sauver quoique ce soit comme le dit bien l'aide.

Option Explicit

Public ThePathOnly As String
Public ThePathWithNewExtention As String

Sub CollectGetSaveAsFileName()
Dim MyPath As Variant
Dim FileSaveName As Variant
Dim TheExtention As String
Dim x As Byte

ThePathOnly = ""
ThePathWithNewExtention = ""

FileSaveName = Application.GetSaveAsFilename(InitialFileName:="Le nom que vous souhaitez", _
                                             FileFilter:="Excel File (*.xlsx), *.xlsx", _
                                             Title:="Veuillez seléctionner le folder et le file que vous souhaitez")
If FileSaveName = False Then
        MsgBox "Abandon de l'utilisateur !"
        Exit Sub
Else
        MyPath = Split(FileSaveName, "\")
            For x = 0 To UBound(MyPath) - 1
                 ThePathOnly = ThePathOnly & MyPath(x) & "\"
            Next x
        
        MyPath = Split(FileSaveName, ".")
            For x = 0 To UBound(MyPath)
                 TheExtention = MyPath(x)
            Next x
        ThePathWithNewExtention = Replace(FileSaveName, TheExtention, "PDF")
        MsgBox "Le Chemin seul : " & vbCrLf & ThePathOnly & vbCrLf & vbCrLf & "Le Chemin/Nom avec nouvelle extention : " & vbCrLf & ThePathWithNewExtention
End If

End Sub

A tester sur un classeur vierge, les deux variables Public sont ensuite accessibles pour faire des vrais SaveAs ou autres besoins...

Bien à toi, à vous
@+Thierry

 

[Lord sirc]

Merci d'avoir regardé _Thierry, en effet j'avais bien compris la fonction "GetSaveAsFilename" c'est juste que aujourd'hui je l'ouvre 2 fois pour définir le même chemin au final.

J'ai testé le code que tu as envoyé, il me sélectionne bien le même chemin pour les 2 extensions c'est parfait par contre je n'arrive pas intégrer mais 2 sauvegardes : (

Si tu avais un exemple je suis preneur : )

 

[_Thierry]

Bonjour @Lord sirc , le Forum

Voici un exemple concret ...

Bien à toi, à vous
@+Thierry

 

[Lord sirc]

WAOUH

Merci _Thierry de ton retour rapide, j'ai vu que tu avais créé d'autre fonction pour rappeler les 2 variables or j'essayais de les intégrer directement et pas de la bonne manière. J'ai encore du chemin à faire, je comprend la logique mais j'ai encore du mal à la mettre en application.

Encore merci _Thierry

 

[_Thierry]

Re Bonjour

En fait "SaveAsWorkBook" et "SaveAsPdf" ne sont pas des Function mais des Sub à part entière.
Les Variables que je leur passe sont :
Public ThePDFPathWithNewExtention As String
Public TheXLSPathWithExtention As String

Mais on pourrait aussi intégrer les deux Sub dans la Sub principale aussi (dans ce cas alors pas besoin de déclarer les variables Public en top de module, mais en Dim à l'intérieur de la Sub CollectGetSaveAsFileName

Bon lundi
@+Thierry