【问题标题】:Creating tables at bookmarks in a Word document through Excel VBA from dynamic controls通过 Excel VBA 从动态控件在 Word 文档中的书签处创建表格
【发布时间】:2018-03-09 05:33:49
【问题描述】:

我希望有人能帮助我解决这个问题,因为我已经为此苦苦挣扎了大约一周左右。

我有一个用户窗体,它创建了一组控件(3 个文本框和一个组合框),每次按下按钮时都会将计数器加 1。

我已经编写了一个 Excel VBA 宏,它应该打开一个特定的文档(在最终版本中将是一个 dotx,但在这个测试中是一个 docx)并且;

转到 Word 文档中设置的书签(“table1”) 移动到带有书签的行首 向上移动到上一行 创建一个 1 行 3 列的表。 将第一个和第二个文本框和组合框的值分别插入第 1,2 和 3 列 返回到指定的“table2”书签并对动态创建的控件的每个迭代行重复此操作

宏也应该

转到 Word 文档中设置的书签(“table2”) 移动到带有书签的行首 向上移动到上一行 创建一个 1 行 2 列的表。 将第一个和第三个文本框的值分别插入第 1 列和第 2 列 返回到指定的“table2”书签并对动态创建的控件的每个迭代行重复此操作

所以基本上每个书签如果在宏运行后有3行动态控件应该有

3 行 3 列的表格位于书签“table1”上方,其中包含来自第一个和第二个文本框的值以及组合框的值。 一个 3 行 2 列的表格,位于书签“table2”上方,其中包含来自第一个和第三个文本框值的值。

所以我的问题是,当宏运行时,它要么在文档顶部创建一行表格,在“table1”书签处创建另一行,在“table2”书签处创建另一行,或者创建 3 列表然后在第一个表的第一个单元格内创建另一个 3 列表,依此类推。

我确信我在光标控制方面遗漏了一些东西(因为通常的问题是第一个表格单元格是在文档的第一行创建的,然后光标似乎移动到“table1”书签并且宏继续从那里)。

如果有人能给我一些指示,我将不胜感激,因为我觉得我快到了,但我只是忽略了一些东西。

这是我到目前为止的代码,对于任何未使用的变量,这是餐巾编码的背面。

Private Sub CommandButton14_Click() 'Create WO Letter
'Open WO letter and copy paste data

    Dim objWord As Word.Application
    Dim objDoc As Word.Document

    Dim riskCombo As Control
    Dim theTextBox802 As Control
    Dim theTextBox803 As Control
    Dim theTextBox804 As Control
    Dim b As Integer
    Dim c As Integer

Dim intNoOfColumns

Dim wdDoc

Dim objRange1

Dim objRange2

Dim objTable1

Dim objTable2

    b = iRiskCount
    c = 1


    If Me.WOLetter1.Value = False And Me.WOLetter2.Value = False And Me.WOLetter3.Value = False And Me.WOLetter4.Value = False Then
        MsgBox "You Must Choose a Letter Type"
    Exit Sub

    End If

    If UserForm1.MultiPage1.Pages(2).Frame15.Controls("Risk" & c).Value = "Risk" Then
         MsgBox "Select Risk Level for line " & c
    Exit Sub

    End If

        If Me.WOLetter1.Value = True Then
                Set objWord = New Word.Application
                objWord.DisplayAlerts = False
                objWord.Visible = True
                objWord.Activate
                Set wdDoc = objWord.Documents.Add(ActiveWorkbook.Path & "\WOTest.docx")


        ElseIf Me.WOLetter2.Value = True Then
                Set objWord = New Word.Application
                objWord.DisplayAlerts = False
                objWord.Visible = True
                'objWord.Documents.Open ActiveWorkbook.Path & "\WOTest.docx", ReadOnly:=True '"\test.dotx", ReadOnly:=True'"\Doc.dotm", ReadOnly:=True '"\test.dotx", ReadOnly:=True
                objWord.Activate

        ElseIf Me.WOLetter3.Value = True Then
                Set objWord = New Word.Application
                objWord.DisplayAlerts = False
                objWord.Visible = True
                'objWord.Documents.Open ActiveWorkbook.Path & "\WOTest.docx", ReadOnly:=True '"\test.dotx", ReadOnly:=True'"\Doc.dotm", ReadOnly:=True '"\test.dotx", ReadOnly:=True
                objWord.Activate

        ElseIf Me.WOLetter4.Value = True Then
                Set objWord = New Word.Application
                objWord.DisplayAlerts = False
                objWord.Visible = True
                'objWord.Documents.Open ActiveWorkbook.Path & "\WOTest.docx", ReadOnly:=True '"\test.dotx", ReadOnly:=True'"\Doc.dotm", ReadOnly:=True '"\test.dotx", ReadOnly:=True
                objWord.Activate

        End If



        For Each riskCombo In UserForm1.MultiPage1.Pages(2).Frame15.Controls

            If b > 0 Then

            Set objRange1 = objWord.Selection.Range
            Set objRange2 = objWord.Selection.Range

    'Table1
            objWord.Selection.GoTo What:=wdGoToBookmark, Name:="table1"
            objWord.Selection.HomeKey Unit:=wdLine, Extend:=wdMove
            objWord.Selection.MoveUp     

            wdDoc.Tables.Add objRange1, 1, 3
                objWord.Selection.GoTo What:=wdGoToBookmark, Name:="table1"
                objWord.Selection.HomeKey Unit:=wdLine, Extend:=wdMove
            objWord.Selection.MoveUp
            Set objTable1 = wdDoc.Tables(1)

    'Table 2

            objWord.Selection.GoTo What:=wdGoToBookmark, Name:="table2"
            objWord.Selection.HomeKey Unit:=wdLine, Extend:=wdMove
            objWord.Selection.MoveUp

            wdDoc.Tables.Add objRange2, 1, 2
                objWord.Selection.GoTo What:=wdGoToBookmark, Name:="table2"
                objWord.Selection.HomeKey Unit:=wdLine, Extend:=wdMove
            objWord.Selection.MoveUp
            Set objTable2 = wdDoc.Tables(1)

            With objTable1
                .Cell(0, 1).Range.Text = UserForm1.MultiPage1.Pages(2).Frame15.Controls("Text5" & c).Value
                .Cell(0, 2).Range.Text = UserForm1.MultiPage1.Pages(2).Frame15.Controls("Text6" & c).Value
                .Cell(0, 3).Range.Text = UserForm1.MultiPage1.Pages(2).Frame15.Controls("Risk" & c).Value
            End With

            With objTable2
                .Cell(0, 1).Range.Text = UserForm1.MultiPage1.Pages(2).Frame15.Controls("Text5" & c).Value
                .Cell(0, 2).Range.Text = UserForm1.MultiPage1.Pages(2).Frame15.Controls("Text7" & c).Value
            End With


                    c = c + 1
                    b = b - 1

        End If

    Next riskCombo

            objTable1.Columns(1).SetWidth ColumnWidth:=30, RulerStyle:= _
            wdAdjustNone

            objTable1.Columns(2).SetWidth ColumnWidth:=350, RulerStyle:= _
            wdAdjustNone

            objTable1.Columns(3).SetWidth ColumnWidth:=75, RulerStyle:= _
            wdAdjustNone

            objTable2.Columns(1).SetWidth ColumnWidth:=30, RulerStyle:= _
            wdAdjustNone

            objTable2.Columns(2).SetWidth ColumnWidth:=425, RulerStyle:= _
            wdAdjustNone


End Sub 'end of test

即使我在这方面走在正确的轨道上,我也会很感激,因为过去一周我一直在反对这个问题。

【问题讨论】:

  • 您将表一和表二设置为相同。他们应该不同吗? "设置 objTable1 = wdDoc.Tables(1)" "设置 objTable2 = wdDoc.Tables(1)"
  • 是的,你是对的,这是我的疏忽。道歉
  • 这就是答案吗?
  • 是的。我必须分别设置两个表,所以我将它们放入单独的循环中,而不是它们都在同一个 For Each 循环中。
  • 好的,我在下面给出了答案。您可以将其标记为关闭此问题。

标签: excel ms-word bookmarks vba


【解决方案1】:

您将表一和表二设置为相同。

"Set objTable1 = wdDoc.Tables(1)" 
"Set objTable2 = wdDoc.Tables(1)"

【讨论】:

    猜你喜欢
    • 2023-04-09
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2010-09-21
    • 1970-01-01
    • 1970-01-01
    • 2016-08-28
    • 1970-01-01
    相关资源
    最近更新 更多