Συνδυασμός πολλών πινάκων του Excel σε ένα έγγραφο Word με VBA

Ενοποίηση πολλών πινάκων Excel σε ένα έγγραφο λέξης

Αυτό το σενάριο δείχνει πώς να χρησιμοποιήσετε το VBA στο Excel για να συνδυάσετε πολλούς πίνακες σε ένα μόνο έγγραφο του Word, με αλλαγές σελίδας μετά από κάθε πίνακα.

Sub ConsolidateTablesInOneDocument()
    Dim wdApp As New Word.Application
    Dim wdDoc As Word.Document
    Dim wdTbl As Word.Table
    Dim xlSht As Worksheet
    Dim lRow As Integer, lCol As Integer
    Dim r As Integer, c As Integer
    Dim Blanks As Integer, First As Integer, Second As Integer
    lRow = Sheets("Feedback Sheets").Range("A1000").End(xlUp).Row - 2
    Blanks = 0
    i = 1
    Do While i <= lRow
        Set rRng = Worksheets("Feedback Sheets").Range("A" & i)
        If IsEmpty(rRng.Value) Then
            Blanks = Blanks + 1
            If Blanks = 1 Then First = i
            If Blanks = 2 Then Second = i
        End If
        i = i + 1
    Loop
    Set xlSht = ActiveSheet: lCol = 5
    With wdApp
        .Visible = True
        Set wdDoc = .Documents.Add
        Call CreateTable(wdDoc, xlSht, 1, First, lCol)
        wdDoc.Characters.Last.InsertBreak Type:=wdPageBreak
        Call CreateTable(wdDoc, xlSht, First + 1, Second, lCol)
        wdDoc.Characters.Last.InsertBreak Type:=wdPageBreak
        Call CreateTable(wdDoc, xlSht, Second + 1, lRow, lCol)
    End With
End Sub
Sub CreateTable(wdDoc As Word.Document, xlSht As Worksheet, startRow As Integer, endRow As Integer, lCol As Integer)
    Dim wdTbl As Word.Table
    Dim r As Integer, c As Integer
    Set wdTbl = wdDoc.Tables.Add(Range:=wdDoc.Range, NumRows:=2, NumColumns:=lCol)
    With wdTbl
        .Rows(1).Range.Font.Bold = True
        .Rows(1).HeadingFormat = True
        .Cell(1, 1).Range.Text = "Header 1"
        If lCol > 1 Then .Cell(1, 2).Range.Text = "Header 2"
        If lCol > 2 Then .Cell(1, 3).Range.Text = "Header 3"
        For r = startRow To endRow
            If (r - startRow + 2) > .Rows.Count Then .Rows.Add
            For c = 1 To lCol
                .Cell(r - startRow + 2, c).Range.Text = xlSht.Cells(r, c).Text
            Next c
        Next r
    End With
    With wdTbl.Borders
        .InsideLineStyle = wdLineStyleSingle
        .OutsideLineStyle = wdLineStyleDouble
    End With
End Sub

Συγχώνευση δεδομένων Excel σε Word με VBA

Αυτό το σενάριο χρησιμοποιεί VBA για τη συγχώνευση πινάκων από ένα φύλλο Excel σε ένα ενιαίο έγγραφο του Word, διασφαλίζοντας σωστή μορφοποίηση και αλλαγές σελίδας.

Sub MergeTablesIntoWord()
    Dim wdApp As New Word.Application
    Dim wdDoc As Word.Document
    Dim wdTbl As Word.Table
    Dim xlSht As Worksheet
    Dim lRow As Integer, lCol As Integer
    Dim r As Integer, c As Integer
    Dim Blanks As Integer, First As Integer, Second As Integer
    lRow = Sheets("Feedback Sheets").Range("A1000").End(xlUp).Row - 2
    Blanks = 0
    i = 1
    Do While i <= lRow
        Set rRng = Worksheets("Feedback Sheets").Range("A" & i)
        If IsEmpty(rRng.Value) Then
            Blanks = Blanks + 1
            If Blanks = 1 Then First = i
            If Blanks = 2 Then Second = i
        End If
        i = i + 1
    Loop
    Set xlSht = ActiveSheet: lCol = 5
    With wdApp
        .Visible = True
        Set wdDoc = .Documents.Add
        Set wdTbl = wdDoc.Tables.Add(Range:=wdDoc.Range, NumRows:=2, NumColumns:=lCol)
        PopulateTable wdTbl, xlSht, 1, First, lCol
        wdDoc.Characters.Last.InsertBreak Type:=wdPageBreak
        Set wdTbl = wdDoc.Tables.Add(Range:=wdDoc.Range, NumRows:=2, NumColumns:=lCol)
        PopulateTable wdTbl, xlSht, First + 1, Second, lCol
        wdDoc.Characters.Last.InsertBreak Type:=wdPageBreak
        Set wdTbl = wdDoc.Tables.Add(Range:=wdDoc.Range, NumRows:=2, NumColumns:=lCol)
        PopulateTable wdTbl, xlSht, Second + 1, lRow, lCol
    End With
End Sub
Sub PopulateTable(wdTbl As Word.Table, xlSht As Worksheet, startRow As Integer, endRow As Integer, lCol As Integer)
    Dim r As Integer, c As Integer
    With wdTbl
        .Rows(1).Range.Font.Bold = True
        .Rows(1).HeadingFormat = True
        .Cell(1, 1).Range.Text = "Header 1"
        If lCol > 1 Then .Cell(1, 2).Range.Text = "Header 2"
        If lCol > 2 Then .Cell(1, 3).Range.Text = "Header 3"
        For r = startRow To endRow
            If (r - startRow + 2) > .Rows.Count Then .Rows.Add
            For c = 1 To lCol
                .Cell(r - startRow + 2, c).Range.Text = xlSht.Cells(r, c).Text
            Next c
        Next r
    End With
    With wdTbl.Borders
        .InsideLineStyle = wdLineStyleSingle
        .OutsideLineStyle = wdLineStyleDouble
    End With
End Sub

Συχνές ερωτήσεις σχετικά με τις μακροεντολές VBA για Word και Excel

1. Πώς μπορώ να ξεκινήσω μια νέα εφαρμογή Word χρησιμοποιώντας VBA;
2. Χρήση για να αρχικοποιήσετε μια νέα παρουσία της εφαρμογής Word.
3. Πώς μπορώ να εισαγάγω μια αλλαγή σελίδας σε ένα έγγραφο του Word χρησιμοποιώντας VBA;
4. Εισαγάγετε μια αλλαγή σελίδας με .
5. Πώς μπορώ να προσθέσω έναν πίνακα σε ένα έγγραφο του Word χρησιμοποιώντας VBA;
6. Προσθέστε έναν πίνακα χρησιμοποιώντας .
7. Πώς μπορώ να μορφοποιήσω την πρώτη γραμμή ενός πίνακα ως κεφαλίδα;
8. Ορίστε την πρώτη σειρά ως κεφαλίδα με και κάντε το τολμηρό χρησιμοποιώντας .
9. Πώς μπορώ να ορίσω περιγράμματα για έναν πίνακα στο Word χρησιμοποιώντας VBA;
10. Ορίστε τα σύνορα με , καθορίζοντας στυλ για εσωτερικές και εξωτερικές γραμμές.
11. Πώς μπορώ να κάνω την εφαρμογή Word ορατή στον χρήστη στο VBA;
12. Ρυθμίστε την ορατότητα με .
13. Ποια εντολή χρησιμοποιείται για την προσθήκη μιας νέας σειράς σε έναν πίνακα εάν η τρέχουσα σειρά υπερβαίνει τον υπάρχοντα αριθμό γραμμών;
14. Προσθήκη νέας σειράς με .
15. Πώς μπορώ να δημιουργήσω ένα νέο έγγραφο στο Word χρησιμοποιώντας VBA;
16. Δημιουργία νέου εγγράφου με .