Code VBA pour enregistrer fichier en pdf et en xlsm
Bonsoir,
Ayant créé un devis excel, j'ai inséré un bouton pour que mon fichier s'enregistre en pdf sous la forme DEVIS+NOM DU CLIENT
Voici mon code :
Sub DEVIS()
Dim nompdf As String
Dim dossier As String
Dim sh As Worksheet
Set sh = Worksheets("DEVIS")
dossier = ThisWorkbook.Path
'masque les colonnes B et E
sh.Range("B:B,E:E").EntireColumn.Hidden = True
nompdf = dossier & "\" & "Devis" & ActiveSheet.Range("h13")
sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nompdf & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
'affiche les colonnes B et E
sh.Range("B:B,E:E").EntireColumn.Hidden = False
End Sub
Le code fonctionne mais je souhaiterais l'améliorer, à savoir :
1) choisir le chemin pour que le fichier PDF s'enregistre dans mon dossier DEVIS et non sur le bureau
2) actuellement, si un devis existe déjà pour ce client, il est effacé par le nouveau ; je souhaiterais qu'il incrémente un nouveau nom avec DEVISNOM2 par exemple
3) je souhaiterais également que mon document s'enregistre aussi en xlsm dans un fichier DEVISEXCEL également avec incrémentation, ceci afin de pouvoir y apporter d'éventuelles modifications
4) Enfin, j'aimerais que mon document DEVIS de base se ferme sans enregistrer les modifications
Je suis novice en VBA et j'essaie, comme beaucoup de débutants je pense, de copier et adapter des codes créés par des experts mais ce n'est pas toujours évident à comprendre.
Je vous remercie de votre aide et du temps que vous voudrez bien me consacrer,
Je suis novice en VBA et j'essaie, comme beaucoup de débutants je pense, de copier et adapter des codes créés par des experts mais ce n'est pas toujours évident à comprendre.
Je vous remercie de votre aide et du temps que vous voudrez bien me consacrer,
Bonjour choupie972,
je pense que si tu veux vraiment apprendre le langage vba
, il vaux mieux posé une question à la fois
pour mieux comprendre la réponse.
par exemple:
1) choisir le chemin pour que le fichier PDF s'enregistre dans mon dossier DEVIS et non sur le bureau
le code pour choisir le répertoire:
Dim FD As FileDialog, oFolder As Object
Set FD = Application.FileDialog(msoFileDialogFolderPicker)
With FD
.AllowMultiSelect = False
.Show
oFolder = .SelectedItems(1)
Debug.Print oFolder 'preuve du chemin choisi: s'affiche sur la fenêtre exécution
End With
dans ton code tu utilise
nompdf = dossier & "\" & "Devis" & ActiveSheet.Range("h13")
il faudra remplacer
dossier
par
oFolder
Bonjour à tous,
deux petits conseils pour enregistrer au format PDF.
Si le chemin est toujours le même on peut l'écrire directement dans le code.
Pour vérifier si le nom de fichier existe et le changer si nécessaire, j'ai adapté deux fonctions.
Voici un exemple à tester:
Sub DEVIS()
'https://forum.excel-pratique.com/viewtopic.php?f=2&t=130216
Dim nompdf As String
Dim dossier As String
Dim sh As Worksheet
Set sh = Worksheets("DEVIS")
dossier = "C:\Users\Username\Desktop\Devis\" '<<=============Chemin à adapter
Application.ScreenUpdating = False
'masque les colonnes B et E
sh.Range("B:B,E:E").EntireColumn.Hidden = True
nompdf = "Devis " & ActiveSheet.Range("H13") & ".pdf"
nompdf = FileNameUnique(dossier, nompdf, ".pdf")
sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=dossier & nompdf, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
'affiche les colonnes B et E
sh.Range("B:B,E:E").EntireColumn.Hidden = False
Application.ScreenUpdating = True
End Sub
Private Function FileNameUnique(strPath As String, _
strFilename As String, _
strExtension As String) As String
'by Graham Mayor - www.gmayor.com/
Dim lngF As Long
Dim lngName As Long
strExtension = Replace(strExtension, Chr(46), "")
'lngF = 1
lngF = 2
lngName = Len(strFilename) - (Len(strExtension) + 1)
strFilename = Left(strFilename, lngName)
'If the filename exists, add or increment a number to the filename
'and keep checking until a unique name is found
Do While FileExists(strPath & strFilename & Chr(46) & strExtension) = True
' strFilename = Left(strFilename, lngName) & "(" & lngF & ")"
strFilename = Left(strFilename, lngName) & " " & lngF
lngF = lngF + 1
Loop
'Reassemble the filename
FileNameUnique = strFilename & Chr(46) & strExtension
lbl_Exit:
Exit Function
End Function
Private Function FileExists(strFullName As String) As Boolean
'by Graham Mayor - www.gmayor.com/
'strFullName is the name with path of the file to check
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(strFullName) Then
FileExists = True
Else
FileExists = False
End If
lbl_Exit:
Set fso = Nothing
Exit Function
End Function
Bonsoir Sequoyah,
Génial !!!
Ca fonctionne à merveille ! Je te remercie beaucoup.
J'avoue que j'étais désorientée par la réponse de i20100 et je n'arrivais pas à comprendre pourquoi il fallait tout modifier.
Ta réponse est plus lisible pour moi et correspond tout à fait à ce que je souhaitais obtenir.
Sans vouloir abuser, pourrais-tu te pencher sur la question relative à l'enregistrement xlsm et à l'enregistrement stp ?
3) je souhaiterais également que mon document s'enregistre aussi en xlsm dans un fichier DEVISEXCEL également avec incrémentation, ceci afin de pouvoir y apporter d'éventuelles modifications
4) Enfin, j'aimerais que mon document DEVIS de base se ferme sans enregistrer les modifications
Est-il possible d'adapter simplement le code que tu m'as proposé en y incluant les paramètres relatifs à EXCEL ou est-ce plus compliqué ?
Je te remercie pour ton aide précieuse,
Bonsoir choupie972,
merci pour ton retour, voici le nouveau code de la macro, les deux fonctions ne changent pas:
Sub DEVIS2()
Dim nompdf As String, NomXl As String
Dim dossier As String, dossierXl As String
Dim sh As Worksheet
Dim Wkb As Workbook
Set sh = Worksheets("DEVIS")
dossier = "C:\Users\Username\Desktop\Devis\" '<<=============Chemin à adapter
dossierXl = "C:\Users\Username\Desktop\DevisExcel\" '<<=============Chemin à adapter
Application.ScreenUpdating = False
'masque les colonnes B et E
sh.Range("B:B,E:E").EntireColumn.Hidden = True
nompdf = "Devis " & ActiveSheet.Range("H13") & ".pdf"
NomXl = "Devis " & ActiveSheet.Range("H13") & ".xlsx"
nompdf = FileNameUnique(dossier, nompdf, ".pdf")
sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=dossier & nompdf, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
'affiche les colonnes B et E
sh.Range("B:B,E:E").EntireColumn.Hidden = False
'Création et enregistrement nouveau fichier
sh.Copy
NomXl = FileNameUnique(dossierXl, NomXl, ".xlsx")
ActiveWorkbook.SaveAs dossierXl & NomXl
ActiveWorkbook.Close
Application.ScreenUpdating = True
ThisWorkbook.Close savechanges:=False
End Sub
Hello Sequoyah,
Encore merci pour ton aide,
C'est presque parfait, à un détail près que tu ne pouvais pas deviner puisque je ne t'ai pas transmis mon fichier,
En fait, mon document DEVIS comporte plusieurs onglets avec des liaisons entre eux et l'enregistrement du devis excel ne prend en compte que la page active. Je ne peux donc pas modifier le devis ultérieurement en cas de besoin.
Comment faire pour que l'enregistrement prenne en compte les différents onglets ?
Merci encore de ton aide vraiment précieuse,
Bonjour choupie972,
change la ligne:
sh.Copy
avec
Sheets(Array("DEVIS", "Recap", "Onglet")).Copy ' à adapter le nom des onglets
Merciii beaucoup Sequoyah,
Tout est parfait, exactement comme je voulais,
A présent, je m'attaque à l'envoi du devis pdf par mail... je vais m'inspirer des conseils que tu as donnés à d'autres utilisateurs,
Merci encore, je ne manquerai pas de t'appeler à l'aide en cas de besoin,
Bonne journée à toi
Bonsoir,
Grace à l'aide de Sequoyah, mon fichier fonctionnait parfaitement.
J'ai fait plusieurs améliorations et lors de la dernière, patatras… impossible de rouvrir mon fichier..
J'ai donc désactivé les macros dans les options d'Excel afin de pouvoir supprimer le morceau de code qui posait problème.
Ca a bien fonctionné et je pensais avoir résolu le problème.
Malheureusement, lors de la tentative d'enregistrement suivante, message d'erreur comme quoi "les fonctionnalités suivantes ne peuvent pas être enregistrées dans des classeurs sans macro : Projet VB"
Je précise que j'avais bien réactivé les macros dans les options d'Excel.
Le débogage pointe sur la ligne :
ActiveWorkbook.SaveAs dossierXl & nomXl
sachant que le nomXl est défini ainsi
nomXl = FileNameUnique(dossierXl, nomXl, ".xlsm")
Je pense que le problème doit venir de la fonction FileNameUnique qui fonctionnait jusqu'ici.
Par contre, je ne comprends pas du tout cette fonction et je ne sais que faire pour remédier à mon problème.
Cette fonction est dans la réponse de Sequoyah du 29sept.
Merci de votre aide,
Bonjour choupie972,
je pense que le problème n'est pas dans la fonction mais dans le fait que dans mon code l'extension du fichier Excel à enregistrer est au format .xlsx et non .xlsm (format de fichier prenant en charge les macros).
Cordialement.
Bonjour Sequoyah,
Merci de ta réponse rapide,
Avant mon bug, tout marchait nickel et j'avais laissé .xlsx
Ensuite, quand il a refusé de m'enregistrer mes fichiers excel, j'ai tenté de modifier en remplaçant .xlsx par .xlsm mais ça ne fonctionne pas mieux.
Aurais-tu une idée pour résoudre ce problème ?
Peut-être supprimer l'enregistrement du fichier excel, enregistrer et ressaisir ensuite le code pour l'enregistrement excel ?
Penses-tu que cela pourrait résoudre mon problème ?
Merci encore de ton aide,
Sequoyah,
Oups, je viens de réaliser qu'effectivement, tous mes devis enregistrés sous excel ne supportent pas les macros et sont donc inutilisables en l'état.
En fait, je souhaiterais enregistrer mes devis en pdf pour envoyer au client et en xlsm pour pouvoir ensuite les transformer en facture.
Comment faire pour que je ne sois pas obligée de retaper mon devis pour le transformer en facture ou pour le modifier ?
Aurais-tu une suggestion ?
Merci de ton aide,
Bonjour,
le fait que les fichiers ne soient pas au format xlsm ne devrait pas empêcher la transformation en facture, tu dois mieux spécifier comment tu fais le passage du devis à la facture.
Edit:
Pour enregistrer au format .xlsm change la ligne:
ActiveWorkbook.SaveAs dossierXl & NomXl
par:
ActiveWorkbook.SaveAs dossierXl & NomXl, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Le problème vient du fait que tout se fait par macro.
J'ai un bouton d'appel de userform sur mon document devis et je choisis ensuite ce que je veux faire : soit un devis soit une facture.
Mais forcément, quand je reviens sur mon document devis excel, les macros sont désactivées et donc impossible d'avoir accès au userform.
J'avoue que je bloque un peu sur la façon de faire.
Bonjour choupie972,
j'ai changé dans mon dernier post le code pour la sauvegarde du classeur au format .xslm, on peut ensuite glisser-déposer le userform dans le nouveau fichier ou exporter le userform avec le code suivant (à adapter les noms du fichier et du userform):
A' cocher dans les paramètres des macros Accès approuvé au modèle d'objet du projet VBA.
Sub ImportForm()
Dim wbSource As Workbook, wbDestination As Workbook
Set wbSource = ThisWorkbook
Set wbDestination = Workbooks("DEVIS - 2.xlsm") 'A' adapter
wbSource.VBProject.VBComponents("UserForm1").Export "UserForm1.frm"
wbDestination.VBProject.VBComponents.Import "UserForm1.frm"
Kill "UserForm1.frm"
Kill "UserForm1.frx"
End Sub
Alors, j'ai changé le code comme tu m'as indiqué,
A présent, les devis excel s'enregistrent bien en xlsm
Par contre, lorsque je retourne sur un devis pour le modifier ou le transformer en facture, j'ai un message d'erreur qui vient du fait que mon userform de validation n'est pas enregistré dans les vba objects de mon nouveau document.
Est-ce un problème d'enregistrement du userform ? Y a t il un paramètre à définir pour qu'il s'enregistre avec le nouveau document ?
Merci encore de ton aide et du temps que tu me consacres,
Oups, nos messages se sont croisés…
Je me penche de suite sur ta réponse,
Merci
Désolée de t'embêter encore,
J'ai un souci avec le nom à renseigner dans le wbDestination,
J'ai essayé comme ça mais ça ne fonctionne pas :
'création et enregistrement fichier excel
Sheets(Array("DEVIS", "DETAIL PRESTATIONS", "CLIENTS", "CHRONO DEVIS")).Copy
nomXl = FileNameUnique(dossierXl, nomXl, ".xlsm")
ActiveWorkbook.SaveAs dossierXl & nomXl, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Dim wbSource As Workbook, wbDestination As Workbook
Set wbSource = ThisWorkbook
Set wbDestination = Workbooks(FileNameUnique(dossierXl, nomXl, ".xlsm")
wbSource.VBProject.VBComponents.Import "UserForm4.frm"
Kill "UserForm4.frm"
Kill "UserForm4.frx"
ActiveWorkbook.Close
Apparemment, je n'ai pas renseigné le bon nom dans wbDestination
Re-bonjour choupie972,
peux-tu joindre un fichier exemple, sans données confidentielles?
Aujourd'hui, je dois quitter mais je vais voir ça dans les prochains jours.
A' tester:
'Création et enregistrement nouveau fichier
Sheets(Array("DEVIS", "DETAIL PRESTATIONS", "CLIENTS", "CHRONO DEVIS")).Copy
NomXl = FileNameUnique(dossierXl, NomXl, ".xlsm")
ThisWorkbook.VBProject.VBComponents("UserForm1").Export "UserForm4.frm"
ActiveWorkbook.VBProject.VBComponents.Import "UserForm4.frm"
Kill "UserForm4.frm"
Kill "UserForm4.frx"
ActiveWorkbook.SaveAs dossierXl & NomXl, FileFormat:=xlOpenXMLWorkbookMacroEnabled
ActiveWorkbook.Close