Problème d'exportation en VBA de xls à docx et pdf
RésoluIvyJu Messages postés 25 Statut Membre -
Bonjour,
J'ai un problème lorsque je fais mon exportation. Je voudrais que ça n'exporte que ce que j'ai qui est affiché dans mon formulaire ouvert qui s'appelle lbm_frm_ajouter. Mais ça me fait un document par ligne. Je ne sais pas comment m'en sortir. Je vous mets le code de mon bouton exporter ci-dessous:
Private Sub ExporterVersWordEtPDF_Click()
Dim wdApp As Object
Dim wdDoc As Object
Dim ws As Worksheet
Dim rng As Range
Dim cheminModele As String
Dim cheminExportWord As String
Dim cheminExportPDF As String
Dim nomFichier As String
' Définir les chemins
cheminModele = ThisWorkbook.Path & "\ldm.docx"
cheminExportWord = ThisWorkbook.Path & "\ldm\word\"
cheminExportPDF = ThisWorkbook.Path & "\ldm\pdf\"
' S'assurer que les répertoires d'exportation existent
If Dir(cheminExportWord, vbDirectory) = "" Then
MkDir cheminExportWord
End If
If Dir(cheminExportPDF, vbDirectory) = "" Then
MkDir cheminExportPDF
End If
' Créer une nouvelle instance de Word
Set wdApp = CreateObject("Word.Application")
' Ouvrir le modèle Word
Set wdDoc = wdApp.Documents.Open(cheminModele)
' Définir la feuille de calcul
Set ws = ThisWorkbook.Sheets("ldm_donnees") ' Remplacez "Feuille1" par le nom de votre feuille
' Parcourir les lignes et exporter les données
For Each rng In ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row) ' Ajustez la plage si nécessaire
' Remplacer les espaces réservés par les données
With wdDoc.Content.Find
.Text = "<nom_entreprise>"
.Replacement.Text = rng.Offset(0, 0).Value ' nom_entreprise
.Execute Replace:=2
.Text = "<type_entreprise>"
.Replacement.Text = rng.Offset(0, 1).Value ' type_entreprise
.Execute Replace:=2
.Text = "<num_rue_entreprise>"
.Replacement.Text = rng.Offset(0, 2).Value ' num_rue_entreprise
.Execute Replace:=2
.Text = "<rue_entreprise>"
.Replacement.Text = rng.Offset(0, 3).Value ' rue_entreprise
.Execute Replace:=2
.Text = "<npa_entreprise>"
.Replacement.Text = rng.Offset(0, 4).Value ' npa_entreprise
.Execute Replace:=2
.Text = "<ville_entreprise>"
.Replacement.Text = rng.Offset(0, 5).Value ' ville_entreprise
.Execute Replace:=2
.Text = "<siret>"
.Replacement.Text = rng.Offset(0, 6).Value ' siret
.Execute Replace:=2
.Text = "<immat_rcs>"
.Replacement.Text = rng.Offset(0, 7).Value ' immat_rcs
.Execute Replace:=2
.Text = "<capital>"
.Replacement.Text = rng.Offset(0, 8).Value ' capital
.Execute Replace:=2
.Text = "<titre_representant>"
.Replacement.Text = rng.Offset(0, 9).Value ' titre_representant
.Execute Replace:=2
.Text = "<nom_representant>"
.Replacement.Text = rng.Offset(0, 10).Value ' nom_representant
.Execute Replace:=2
.Text = "<prenom_representant>"
.Replacement.Text = rng.Offset(0, 11).Value ' prenom_representant
.Execute Replace:=2
.Text = "<activite>"
.Replacement.Text = rng.Offset(0, 12).Value ' activite
.Execute Replace:=2
.Text = "<debut>"
.Replacement.Text = rng.Offset(0, 13).Value ' debut
.Execute Replace:=2
.Text = "<fin>"
.Replacement.Text = rng.Offset(0, 14).Value ' fin
.Execute Replace:=2
.Text = "<effectif>"
.Replacement.Text = rng.Offset(0, 15).Value ' effectif
.Execute Replace:=2
.Text = "<forfait_ht>"
.Replacement.Text = rng.Offset(0, 16).Value ' forfait_ht
.Execute Replace:=2
.Text = "<forfait_ttc>"
.Replacement.Text = rng.Offset(0, 17).Value ' forfait_ttc
.Execute Replace:=2
.Text = "<bulletin_forfait>"
.Replacement.Text = rng.Offset(0, 18).Value ' bulletin_forfait
.Execute Replace:=2
.Text = "<max_ou_pas>"
.Replacement.Text = rng.Offset(0, 19).Value ' max_ou_pas
.Execute Replace:=2
.Text = "<acompte_ht>"
.Replacement.Text = rng.Offset(0, 20).Value ' acompte_ht
.Execute Replace:=2
.Text = "<acompte_ttc>"
.Replacement.Text = rng.Offset(0, 21).Value ' acompte_ttc
.Execute Replace:=2
.Text = "<bulletin_acompte>"
.Replacement.Text = rng.Offset(0, 22).Value ' bulletin_acompte
.Execute Replace:=2
.Text = "<x>"
.Replacement.Text = rng.Offset(0, 23).Value ' x
.Execute Replace:=2
.Text = "<y>"
.Replacement.Text = rng.Offset(0, 24).Value ' y
.Execute Replace:=2
.Text = "<tarif_bulletin>"
.Replacement.Text = rng.Offset(0, 25).Value ' tarif_bulletin
.Execute Replace:=2
.Text = "<facture_ht>"
.Replacement.Text = rng.Offset(0, 26).Value ' facture_ht
.Execute Replace:=2
.Text = "<facture_ttc>"
.Replacement.Text = rng.Offset(0, 27).Value ' facture_ttc
.Execute Replace:=2
.Text = "<debut_mission>"
.Replacement.Text = rng.Offset(0, 28).Value ' debut_mission
.Execute Replace:=2
.Text = "<lieu>"
.Replacement.Text = rng.Offset(0, 29).Value ' lieu
.Execute Replace:=2
.Text = "<date_contrat>"
.Replacement.Text = rng.Offset(0, 30).Value ' date_contrat
.Execute Replace:=2
End With
' Définir le nom du fichier
nomFichier = "ldm_" & rng.Offset(0, 0).Value & "_" & rng.Offset(0, 1).Value
' Enregistrer le document Word
wdDoc.SaveAs2 cheminExportWord & nomFichier & ".docx"
' Enregistrer le document en PDF
wdDoc.ExportAsFixedFormat OutputFileName:=cheminExportPDF & nomFichier & ".pdf", ExportFormat:=17
' Fermer le document Word sans enregistrer les modifications (car le fichier a déjà été enregistré)
wdDoc.Close SaveChanges:=False
' Ouvrir le PDF enregistré
Shell "explorer.exe " & cheminExportPDF & nomFichier & ".pdf", vbNormalFocus
' Ouvrir un nouveau document basé sur le modèle pour la prochaine itération
Set wdDoc = wdApp.Documents.Open(cheminModele)
Next rng
' Fermer l'application Word
wdApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing
MsgBox "Exportation terminée avec succès !"
End Sub
Merci infiniment pour votre aide :)
- Problème d'exportation en VBA de xls à docx et pdf
- Lire le coran en français pdf - Télécharger - Histoire & Religion
- Comment ouvrir un fichier docx ? - Guide
- Docx - Guide
- Save as pdf office 2007 - Télécharger - Bureautique
- Télécharger dictionnaire larousse pdf gratuit - Télécharger - Dictionnaires & Langues
2 réponses
Bonjour,
Actuellement, vous parcourez chaque ligne avec une boucle For Each rng, ce qui crée un fichier pour chaque ligne.
Extraire les données du formulaire au lieu de parcourir les lignes de la feuille de calcul. Passer ces données directement à Word sans boucle.
Vous pouvez accéder aux contrôles du formulaire (TextBox, ComboBox, etc.) pour obtenir les données que vous souhaitez exporter.
Vous n'avez besoin que d'une seule exportation basée sur les données du formulaire, donc vous pouvez enlever la boucle For Each.
Private Sub ExporterVersWordEtPDF_Click()
Dim wdApp As Object
Dim wdDoc As Object
Dim cheminModele As String
Dim cheminExportWord As String
Dim cheminExportPDF As String
Dim nomFichier As String
' Définir les chemins
cheminModele = ThisWorkbook.Path & "\ldm.docx"
cheminExportWord = ThisWorkbook.Path & "\ldm\word\"
cheminExportPDF = ThisWorkbook.Path & "\ldm\pdf\"
' S'assurer que les répertoires d'exportation existent
If Dir(cheminExportWord, vbDirectory) = "" Then
MkDir cheminExportWord
End If
If Dir(cheminExportPDF, vbDirectory) = "" Then
MkDir cheminExportPDF
End If
' Créer une nouvelle instance de Word
Set wdApp = CreateObject("Word.Application")
' Ouvrir le modèle Word
Set wdDoc = wdApp.Documents.Open(cheminModele)
' Remplacer les espaces réservés par les données du formulaire lbm_frm_ajouter
With wdDoc.Content.Find
.Text = "<nom_entreprise>"
.Replacement.Text = lbm_frm_ajouter.txtNomEntreprise.Value
.Execute Replace:=2
.Text = "<type_entreprise>"
.Replacement.Text = lbm_frm_ajouter.txtTypeEntreprise.Value
.Execute Replace:=2
.Text = "<num_rue_entreprise>"
.Replacement.Text = lbm_frm_ajouter.txtNumRueEntreprise.Value
.Execute Replace:=2
.Text = "<rue_entreprise>"
.Replacement.Text = lbm_frm_ajouter.txtRueEntreprise.Value
.Execute Replace:=2
.Text = "<npa_entreprise>"
.Replacement.Text = lbm_frm_ajouter.txtNPAEntreprise.Value
.Execute Replace:=2
.Text = "<ville_entreprise>"
.Replacement.Text = lbm_frm_ajouter.txtVilleEntreprise.Value
.Execute Replace:=2
.Text = "<siret>"
.Replacement.Text = lbm_frm_ajouter.txtSiret.Value
.Execute Replace:=2
.Text = "<immat_rcs>"
.Replacement.Text = lbm_frm_ajouter.txtImmatRCS.Value
.Execute Replace:=2
.Text = "<capital>"
.Replacement.Text = lbm_frm_ajouter.txtCapital.Value
.Execute Replace:=2
.Text = "<titre_representant>"
.Replacement.Text = lbm_frm_ajouter.txtTitreRepresentant.Value
.Execute Replace:=2
.Text = "<nom_representant>"
.Replacement.Text = lbm_frm_ajouter.txtNomRepresentant.Value
.Execute Replace:=2
.Text = "<prenom_representant>"
.Replacement.Text = lbm_frm_ajouter.txtPrenomRepresentant.Value
.Execute Replace:=2
.Text = "<activite>"
.Replacement.Text = lbm_frm_ajouter.txtActivite.Value
.Execute Replace:=2
.Text = "<debut>"
.Replacement.Text = lbm_frm_ajouter.txtDebut.Value
.Execute Replace:=2
.Text = "<fin>"
.Replacement.Text = lbm_frm_ajouter.txtFin.Value
.Execute Replace:=2
.Text = "<effectif>"
.Replacement.Text = lbm_frm_ajouter.txtEffectif.Value
.Execute Replace:=2
.Text = "<forfait_ht>"
.Replacement.Text = lbm_frm_ajouter.txtForfaitHT.Value
.Execute Replace:=2
.Text = "<forfait_ttc>"
.Replacement.Text = lbm_frm_ajouter.txtForfaitTTC.Value
.Execute Replace:=2
.Text = "<bulletin_forfait>"
.Replacement.Text = lbm_frm_ajouter.txtBulletinForfait.Value
.Execute Replace:=2
.Text = "<max_ou_pas>"
.Replacement.Text = lbm_frm_ajouter.txtMaxOuPas.Value
.Execute Replace:=2
.Text = "<acompte_ht>"
.Replacement.Text = lbm_frm_ajouter.txtAcompteHT.Value
.Execute Replace:=2
.Text = "<acompte_ttc>"
.Replacement.Text = lbm_frm_ajouter.txtAcompteTTC.Value
.Execute Replace:=2
.Text = "<bulletin_acompte>"
.Replacement.Text = lbm_frm_ajouter.txtBulletinAcompte.Value
.Execute Replace:=2
.Text = "<x>"
.Replacement.Text = lbm_frm_ajouter.txtX.Value
.Execute Replace:=2
.Text = "<y>"
.Replacement.Text = lbm_frm_ajouter.txtY.Value
.Execute Replace:=2
.Text = "<tarif_bulletin>"
.Replacement.Text = lbm_frm_ajouter.txtTarifBulletin.Value
.Execute Replace:=2
.Text = "<facture_ht>"
.Replacement.Text = lbm_frm_ajouter.txtFactureHT.Value
.Execute Replace:=2
.Text = "<facture_ttc>"
.Replacement.Text = lbm_frm_ajouter.txtFactureTTC.Value
.Execute Replace:=2
.Text = "<debut_mission>"
.Replacement.Text = lbm_frm_ajouter.txtDebutMission.Value
.Execute Replace:=2
.Text = "<lieu>"
.Replacement.Text = lbm_frm_ajouter.txtLieu.Value
.Execute Replace:=2
.Text = "<date_contrat>"
.Replacement.Text = lbm_frm_ajouter.txtDateContrat.Value
.Execute Replace:=2
End With
' Définir le nom du fichier basé sur les données du formulaire
nomFichier = "ldm_" & lbm_frm_ajouter.txtNomEntreprise.Value & "_" & lbm_frm_ajouter.txtTypeEntreprise.Value
' Enregistrer le document Word
wdDoc.SaveAs2 cheminExportWord & nomFichier & ".docx"
' Enregistrer le document en PDF
wdDoc.ExportAsFixedFormat OutputFileName:=cheminExportPDF & nomFichier & ".pdf", ExportFormat:=17
' Fermer le document Word sans enregistrer les modifications
wdDoc.Close SaveChanges:=False
' Ouvrir le PDF enregistré
Shell "explorer.exe " & cheminExportPDF & nomFichier & ".pdf", vbNormalFocus
' Fermer l'application Word
wdApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing
MsgBox "Exportation terminée avec succès !"
End Sub
Cela devrait limiter l'exportation à ce qui est affiché dans le formulaire lbm_frm_ajouter.