Problème d'exportation en VBA de xls à docx et pdf
Résolu
IvyJu
Messages postés
19
Date d'inscription
lundi 20 janvier 2020
Statut
Membre
Dernière intervention
14 septembre 2024
-
13 sept. 2024 à 22:38
IvyJu Messages postés 19 Date d'inscription lundi 20 janvier 2020 Statut Membre Dernière intervention 14 septembre 2024 - 14 sept. 2024 à 08:31
IvyJu Messages postés 19 Date d'inscription lundi 20 janvier 2020 Statut Membre Dernière intervention 14 septembre 2024 - 14 sept. 2024 à 08:31
A voir également:
- 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
- Comment faire un pdf - Guide
- Save as pdf - Télécharger - Bureautique
2 réponses
IvyJu
Messages postés
19
Date d'inscription
lundi 20 janvier 2020
Statut
Membre
Dernière intervention
14 septembre 2024
1
14 sept. 2024 à 08:31
14 sept. 2024 à 08:31
Merci c'est super ça fonctionne très bien ☺️
Bruno83200_6929
Messages postés
282
Date d'inscription
jeudi 18 juin 2020
Statut
Membre
Dernière intervention
23 octobre 2024
57
14 sept. 2024 à 08:27
14 sept. 2024 à 08:27
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.