word vba:获取ActiveX控件在表中的位置_Vba_Ms Word

word vba:获取ActiveX控件在表中的位置

vba ms-word

word vba:获取ActiveX控件在表中的位置,vba,ms-word,Vba,Ms Word,我想获得ActiveX按钮在表格中的位置（行和列）。到目前为止，我只知道如何按按钮 Selection.Fields.Item(1).OLEFormat.Object 中列出了所有ActiveX控件 Me.Content.InlineShapes 似乎我可以通过访问父表 selection.tables.item(1) 但我不知道如何确定按钮在该表中的位置，例如c5r8，我使用以下代码逐步测试我的理论。结果证明是正确的 Private Sub TestAX() Dim Rng

我想获得ActiveX按钮在表格中的位置（行和列）。到目前为止，我只知道如何按按钮

Selection.Fields.Item(1).OLEFormat.Object

中列出了所有ActiveX控件

Me.Content.InlineShapes

似乎我可以通过访问父表

selection.tables.item(1)

但我不知道如何确定按钮在该表中的位置，例如c5r8，我使用以下代码逐步测试我的理论。结果证明是正确的

Private Sub TestAX()

    Dim Rng As Range

    With ActiveDocument.Tables(1).Range
'        Debug.Print .Start, .End
'        Debug.Print .InlineShapes.Count
'        Debug.Print .InlineShapes(1).OLEFormat.Object.Name
        Set Rng = .InlineShapes(1).Range
    End With

    With Rng
'        Debug.Print .Start, .End
'        Debug.Print .Cells.Count
        Debug.Print .Cells(1).ColumnIndex, .Cells(1).RowIndex
    End With
End Sub

我开始时只使用了一个，第一个，

Debug.Print

。当它工作时，我禁用了该行并尝试了下一行，直到最终得到我想要的结果。下一步是创建一个循环，使用今天早上早些时候描述的循环遍历表中的所有InlineShapes。

感谢您的输入，请原谅我反应太晚。在您建议的帮助下，我能够编写一些代码，其目的是：

对包含文档引用的每一行进行编号（我们称之为item）。它甚至可以区分平原和平原文本和文本字段
在每行的最后一个单元格中创建一个包含项目的按钮，并为每个按钮添加代码
试图清除中间窗口，但它会清除我的代码窗口或不执行任何操作，具体取决于选择的方法。所以它还是有车的

代码变得相当复杂，因为删除已经存在的按钮的代码不能很好地工作。最后我得出的结论是，这是由于Word中的一个bug造成的

对行重新编号的代码主要是自我解释的。我遇到了两大障碍：

一旦该列包含与另一列中的单元格合并的单元格，就不能遍历该列的所有单元格

任何单元格的内容都以点（chr 7）加换行符（char 13）结尾，请参见。
在对单元格内容进行任何数字检查之前，必须删除这些字符。我为此编写了一个小函数（toRemoveFromString）

为了弄清楚一行是否需要编号，我的证明很简单。它只是检查行中的第一个单元格是否为数字，这意味着您必须在运行代码之前准备好表，否则它将无法工作。为了保持较低的处理时间，仅当循环的当前单元格位于最后一列时才执行检查。从那里开始，我引用第一个单元格等。
为了区分单元格是否包含文本表单字段，我通过属性

…Range.FormFields.Count对其进行验证。这意味着每个单元格只能使用纯文本或文本表单字段
只有选择要编辑的表，代码才会起作用，否则我必须搜索整个文档以找到正确的表，但我还没有找到一种简单的方法
Private Sub CB_ReNumberDocTable_Click()
    Dim toRemoveArray() As Variant
    Dim ceTableCell As Cell, ceFirstCellinRow As Cell
    Dim tabThisTable As Table
    Dim i As Integer, iCurrentCol As Integer, iCurrentRow As Integer, iNoCol As Integer
    Dim stCellText As String

    toRemoveArray = Array(Chr(13), Chr(7))
    Set tabThisTable = Selection.Tables(1)
    iNoCol = tabThisTable.Range.Columns.Count
    i = 1

    For Each ceTableCell In tabThisTable.Range.Cells   '.Columns(iNoCol) -> not working since mixed celles
        iCurrentCol = ceTableCell.Range.Cells.Item(1).ColumnIndex
        iCurrentRow = ceTableCell.Range.Cells.Item(1).RowIndex
        If iCurrentCol = iNoCol Then
            Set ceFirstCellinRow = tabThisTable.Cell(iCurrentRow, 1)
            stCellText = toRemoveFromString(ceFirstCellinRow.Range, toRemoveArray)
            If IsNumeric(stCellText) Then
                If ceFirstCellinRow.Range.FormFields.Count = 1 Then
                    ceFirstCellinRow.Range.FormFields.Item(1).Result = Format(i, "00")
                Else
                    ceFirstCellinRow.Range.Text = Format(i, "00")
                End If
            i = i + 1
            End If
        End If
    Next
Set tabThisTable = Nothing
Set ceFirstCellinRow = Nothing

End Sub

我的代码的以下部分变得相当复杂，因为它从未完全删除所有当前按钮。为了便于追溯，我想给任何按钮一个唯一的、自我解释的名称，而不是指Word给出的随机名称。

每个按钮的名称将以行的索引号结尾。这意味着每行只有一个按钮，因此您最好删除所有行中的所有按钮，但具有独立唯一名称的某些按钮除外，例如触发此宏。

删除在我第一次运行它时运行得很好，但从第二次开始，它跳过了一个按钮，但删除了其中一个不相关的按钮，尽管过滤器，决定要删除哪个按钮和哪些按钮不是很简单和清楚
Private Sub CB_CreateSAPButtonsStep1_Click()
    Dim isShape As InlineShape
    Dim isShape1 As InlineShape
    Dim isShape2 As InlineShape
    Dim isShape3 As InlineShape
    Dim tabThisTable As Table
    Dim i As Integer
    Dim stShapeName  As String
    Dim stSenderName As String

        Set tabThisTable = Selection.Tables(1)
        stSenderName = Selection.Fields.Item(1).OLEFormat.Object.Name
        If tabThisTable.Range.InlineShapes.Count > 0 Then
        For i = tabThisTable.Range.InlineShapes.Count To 1 Step -1
            Set isShape = tabThisTable.Range.InlineShapes.Item(i)
            Set isShape1 = tabThisTable.Range.InlineShapes.Item(1)
            Set isShape2 = tabThisTable.Range.InlineShapes.Item(2)
            Set isShape3 = tabThisTable.Range.InlineShapes.Item(3)
            stShapeName = isShape.OLEFormat.Object.Name
            If Not isShape.OLEFormat.Object.Name = isShape1.OLEFormat.Object.Name Then        'stShapeName = "CB_ReNumberDocTable" Then    'InStr(1, isShape.OLEFormat.Object.Name, stSAPButtonName, 1) > 0 Then
                If Not isShape.OLEFormat.Object.Name = isShape2.OLEFormat.Object.Name Then         'stShapeName = "CB_CreateSAPButtonsStep1" Then
                    If Not isShape.OLEFormat.Object.Name = isShape3.OLEFormat.Object.Name Then         'stShapeName = "CB_CreateSAPButtonsStep2" Then
                        Debug.Print "delete :" & isShape.OLEFormat.Object.Name
                        tabThisTable.Range.InlineShapes.Item(i).Delete
                    End If
                End If
            End If
        Next
    End If

    Set tabThisTable = Nothing
    Set isShape = Nothing
End Sub

此代码证明行是否必须编号，作为重新编号代码，并在行的最后一个单元格中插入一个按钮。

之后，按钮被正确重命名和格式化。由于前面解释的错误，is从第二次运行开始失败。所以我删除我必须手动删除剩余的按钮，然后再运行它。幸运的是，我不经常运行它
    Private Sub CB_CreateSAPButtonsStep2_Click()
        Dim toRemoveArray() As Variant
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent, moModul As VBIDE.VBComponent
        Dim tabThisTable As Table
        Dim i As Integer, iCurrentCol As Integer, iCurrentRow As Integer, iNoCol As Integer
        Dim stSAPButtonModuleName As String, stSAPButtonName As String, stCellText As String, stcode As String, 
        Dim isShape As InlineShape
        Dim ceTableCell As Cell, ceFirstCellinRow As Cell                
        iNoCol = Selection.Tables(1).Range.Columns.Count

        stSAPButtonModuleName = "mo_SAPLinkButtons"
        stSAPButtonName = "CB_SAPLink"
        toRemoveArray = Array(Chr(13), Chr(7))

        Set tabThisTable = Selection.Tables(1)
        Set VBProj = ActiveDocument.VBProject

        Application.ScreenUpdating = False

        For Each moModul In VBProj.VBComponents 'http://www.cpearson.com/excel/vbe.aspx
            If moModul.Name = stSAPButtonModuleName Then
                 Set VBComp = VBProj.VBComponents(stSAPButtonModuleName)
                VBProj.VBComponents.Remove VBComp
            End If
        Next
        Set VBComp = VBProj.VBComponents.Add(vbext_ct_StdModule)
        VBComp.Name = stSAPButtonModuleName

        'Exit Sub
        'Debug.Print Now 
'https://social.msdn.microsoft.com/Forums/office/en-US/da87e63f-676b-4505-adeb-564257a56cfe/vba-to-clear-the-immediate-window?forum=exceldev
        'Application.SendKeys "^g ^a {DEL}"

        'Call ClearImmediateWindow
        i = 1
        For Each ceTableCell In tabThisTable.Range.Cells   '.Columns(iNoCol) -> not working since mixed celles
            iCurrentCol = ceTableCell.Range.Cells.Item(1).ColumnIndex
            iCurrentRow = ceTableCell.Range.Cells.Item(1).RowIndex
            If iCurrentCol = iNoCol Then
                Set ceFirstCellinRow = tabThisTable.Cell(iCurrentRow, 1)
                stCellText = toRemoveFromString(ceFirstCellinRow.Range, toRemoveArray)
                If IsNumeric(stCellText) Then
                    'Debug.Print "create shape"
                    'http://ccm.net/faq/1105-adding-a-vba-commandbutton-with-its-respective-the-code
                    'https://support.microsoft.com/de-ch/help/246299/how-to-add-a-button-to-a-word-document-and-assign-its-click-event-at-run-time
                    Set isShape = ceTableCell.Range.InlineShapes.AddOLEControl(ClassType:="Forms.CommandButton.1") ', Left:=0, Top:=0, Width:=15.75, Height:=11.25)
                    isShape.OLEFormat.Object.Caption = ""
                    isShape.OLEFormat.Object.Height = 11.25
                    isShape.OLEFormat.Object.Width = 15.75
                    isShape.OLEFormat.Object.BackColor = RGB(255, 255, 255)  '&HFFFFFF
                    isShape.OLEFormat.Object.ForeColor = RGB(255, 255, 255) '&HFFFFFF
                    isShape.OLEFormat.Object.BackStyle = fmBackStyleTransparent
                    'isShape.OLEFormat.Object.Name = stSAPButtonName & Format(iCurrentRow, "00")

                    stcode = "Private Sub " & isShape.OLEFormat.Object.Name & "_Click()" & vbCrLf & _
                            "   call openSAPLink" & vbCrLf & _
                            "End Sub"
                    Set isShape = Nothing

                    VBProj.VBComponents(stSAPButtonModuleName).CodeModule.AddFromString stcode

                    i = i + 1
                End If
            End If


    '        Debug.Print ceTableCell.Range
    '        Debug.Print ceTableCell.Range.Cells.Item(1).ColumnIndex
    '        Debug.Print ceTableCell.Range.Cells.Item(1).RowIndex
        Next

        Application.ScreenUpdating = True

        Set tabThisTable = Nothing
        Set VBProj = Nothing
        Set VBComp = Nothing
        Set moModul = Nothing
        Set isShape = Nothing
        Set ceFirstCellinRow = Nothing

        For i = 1 To iNoCol
            'Debug.Print Selection.Tables(1).Range.Columns(iNoCol - 1)
        Next
    End Sub

这是一个小帮手，除去了Chr（13）和Chr（7）
清除即时窗口的错误代码仍然存在
Private Sub ClearImmediateWindow()
'https://www.mrexcel.com/forum/excel-questions/300075-clear-visual-basic-applications-editor-immediate-window.html
'https://www.experts-exchange.com/questions/28426212/How-to-clear-the-Immediate-Window-in-VBA.html
'https://access-programmers.co.uk/forums/showthread.php?t=253466
On Error Resume Next
Dim winImm As VBIDE.Window
Dim winActive As VBIDE.Window
  ' set the Window object variable to the Current Window for later reactivation
  Set winActive = VBE.ActiveWindow

  ' set the Window object variable to the Immediate Window
  Set winImm = VBE.Windows("Immediate")
  ' now clear it as you would do "manually"
  winImm.SetFocus
  Application.VBE.Windows.Item("Immediate").SetFocus
  SendKeys "^({Home})", True
  SendKeys "^(+({End}))", True
  SendKeys "{Del}", True
  Debug.Print Now
  Set winImm = Nothing

  'set focus back on window that was active before
  'winActive.SetFocus
End Sub

如果控件是InllneShape，请将其视为Range.Text中的字符。您应该通过查看Range.cell（1）对象找到表格单元格。如果控件是普通形状，则它的位置不会链接到它出现的表格单元格，并且完全由其顶部和左侧属性决定。您能否完整地写出命令，我在“选择”下找不到类似“范围”的任何内容。单元格（1）。。。我找到了Selection.Range.Cells（1）.ColumnIndex
Selection.Range.Cells（1）.RowIndex
我要查找的属性。顺便说一句，顶部和左侧属性都会抛出错误，因此它肯定是一个InlineShape。我突然想到另一个问题。如何枚举表的所有单元格并列出所有插入的InlineShapes，以便在表中创建包含所有ActiveX的数组？行和列索引正确。我更喜欢使用单元格（1）.Range而不是Selection.Range。如果使用表（1）.Range，可以循环遍历其中包含的所有InlineShape，可能与表（1）.Range.InlineShapes中的每个iShape类似。对不起，我没有电脑来测试我刚才写的内容。Cell（1）.Range
无法识别，也无法识别Selection.Cell（1）.Range
或Selection.Range.Cell（1）.Range
Debug.print Selection.Range.Cells（1）.Range可以工作，但输出的是一些非常奇怪的符号，我甚至无法粘贴到这里。
Private Sub ClearImmediateWindow()
'https://www.mrexcel.com/forum/excel-questions/300075-clear-visual-basic-applications-editor-immediate-window.html
'https://www.experts-exchange.com/questions/28426212/How-to-clear-the-Immediate-Window-in-VBA.html
'https://access-programmers.co.uk/forums/showthread.php?t=253466
On Error Resume Next
Dim winImm As VBIDE.Window
Dim winActive As VBIDE.Window
  ' set the Window object variable to the Current Window for later reactivation
  Set winActive = VBE.ActiveWindow

  ' set the Window object variable to the Immediate Window
  Set winImm = VBE.Windows("Immediate")
  ' now clear it as you would do "manually"
  winImm.SetFocus
  Application.VBE.Windows.Item("Immediate").SetFocus
  SendKeys "^({Home})", True
  SendKeys "^(+({End}))", True
  SendKeys "{Del}", True
  Debug.Print Now
  Set winImm = Nothing

  'set focus back on window that was active before
  'winActive.SetFocus
End Sub