Convertir des fichiers Excel d'un dossier en fichiers Word

Y compris Power BI, Power Query et toute autre question en lien avec Excel
a
amadese
Jeune membre
Jeune membre
Messages : 10
Inscrit le : 8 décembre 2017
Version d'Excel : 2013

Message par amadese » 12 décembre 2017, 09:37

Bonjour,

J'ai crée une macro vba Excel qui permet de convertir un rapport excel en word:
Sub export_workbook_to_word()
    Dim sheetName As String
    Set obj = CreateObject("Word.Application")
    obj.Visible = True
    Set newobj = obj.Documents.Add
    
    For Each ws In ActiveWorkbook.Sheets
        sheetName = ws.Name
        
        'Retrieve name of the Worksheet
        newobj.ActiveWindow.Selection.TypeText sheetName
        newobj.ActiveWindow.Selection.Style = ActiveDocument.Styles(-2)
        newobj.ActiveWindow.Selection.TypeParagraph

        ws.UsedRange.Copy
        newobj.ActiveWindow.Selection.PasteExcelTable False, False, False
        newobj.ActiveWindow.Selection.InsertBreak Type:=7

    Next
        newobj.ActiveWindow.Selection.TypeBackspace
        newobj.ActiveWindow.Selection.TypeBackspace
          
    obj.Activate
    newobj.SaveAs Filename:=Application.ActiveWorkbook.Path & "\" & Split(ActiveWorkbook.Name, ".")(0)

End Sub
Ce script fonctionne très bien.

Je voudrais améliorer ce script pour exporter tous les fichiers Excel d'un dossier sélectionné en fichier Word avec une invite pour demander les dossiers des fichiers Excel et le dossier de destination où se trouveront les fichiers Word.

Pourriez-vous m'aider à améliorer ce script En me disant comme mettre en place les invites de commande?

Merci d'avance pour votre aide
a
amadese
Jeune membre
Jeune membre
Messages : 10
Inscrit le : 8 décembre 2017
Version d'Excel : 2013

Message par amadese » 13 décembre 2017, 16:43

J'ai trouvé la solution:
Private Sub ExportExcelToWord_Click()

  Dim xlApp As Object 'Excel.Application
  Dim xlWb As Object 'Excel.Workbook
  Dim xlWs As Object 'Excel.Worksheet
  Dim wdApp As Object 'Word.Application
  Dim wdDoc As Object 'Word.Document
  Dim Path As String
  Dim i As Long
  
  Set xlApp = CreateObject("Excel.Application")
  xlApp.EnableEvents = False
  xlApp.DisplayAlerts = False

  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Choose the destination folder for Word documents"
    If Not .Show Then Exit Sub
    Path = .SelectedItems(1)
    If Right(Path, 1) <> "\" Then Path = Path & "\"
  End With

  With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
    .Title = "Choose the folder with Excel original documents"
    .Filters.Add "Excel files", "*.xls*"
    If Not .Show Then Exit Sub

    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True
    wdApp.DisplayAlerts = 0 'wdAlertsNone

    For i = 1 To .SelectedItems.Count
      Set xlWb = xlApp.Workbooks.Open(.SelectedItems(i), False, True)
      Set wdDoc = wdApp.Documents.Add

      For Each xlWs In xlWb.Worksheets
        wdDoc.ActiveWindow.Selection.TypeText xlWs.Name
        wdDoc.ActiveWindow.Selection.Style = wdDoc.Styles(-2)
        wdDoc.ActiveWindow.Selection.TypeParagraph
        
        xlWs.UsedRange.Copy
        wdDoc.ActiveWindow.Selection.PasteExcelTable False, False, False
        wdDoc.ActiveWindow.Selection.InsertBreak Type:=7
      Next
      wdDoc.ActiveWindow.Selection.TypeBackspace
      wdDoc.ActiveWindow.Selection.TypeBackspace
      wdDoc.SaveAs Path & Split(xlWb.Name, ".")(0)
      wdDoc.Close False
      xlWb.Close False
    Next
  End With
  On Error Resume Next
  wdApp.Quit
  xlApp.Quit

End Sub
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message