دمج جداول Excel متعددة في مستند Word واحد باستخدام VBA

دمج جداول Excel المتعددة في مستند Word واحد

يوضح هذا البرنامج النصي كيفية استخدام 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. قم بإنشاء مستند جديد باستخدام .