Question

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

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

所有ActiveX控件都列在

中

Me.Content.InlineShapes

我似乎可以通过

访问父表

selection.tables.item(1)

但我不知道如何确定该表格中按钮的位置，例如c5r8

Answer 1

我使用以下代码逐步测试我的理论。结果证明是正确的。

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，使用循环，如今天早上所述。

Answer 2

感谢您的投入，并原谅我迟到的回复。在你的建议的帮助下，我能够编写一些代码的目的是：

对每行包含对文档的引用的数字（让我们称之为项目）。它甚至可以区分平原文字和文字字段
在每行的最后一个单元格中创建一个包含项目的按钮，并为每个按钮添加代码
尝试清除中间窗口但是它会清除我的代码窗口或什么也不做，具体取决于所选择的方法。所以它仍然是错误的

代码变得相当复杂，因为删除已经存在的按钮的代码不能很好地工作。最终我得出的结论是由于Word中的错误。

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

只要该列包含与另一列中的单元格合并的单元格，就无法遍历特定列的所有单元格。
任何单元格的内容都以点（chr 7）和换行符（char 13）结尾，请参阅here。
在对单元格内容进行任何数字检查之前，您必须删除这些字符。我为此目的写了一个小函数（ 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给出的随机名称。
每个按钮的名称shell都以行的索引号终止。这意味着每行只有一个按钮，因此您最好删除所有行中的所有按钮，除了具有独立唯一名称的某些按钮，例如，触发这个宏。
第一次运行它时删除运行得很好但是从第二次开始它跳过一个按钮但删除了其中一个不相关的按钮，虽然过滤器，什么决定要删除什么按钮以及什么不是非常简单明了

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

此代码证明行是否必须编号，作为重新编号代码并在行的最后一个单元格中插入一个按钮。
然后按钮被正确地重命名和格式化。由于之前解释的错误从第二次运行开始失败。所以我删除我必须手动删除剩余按钮再次运行它。幸运的是，我不经常这样做。

    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）＆amp; CHR（7）

Private Function toRemoveFromString(stString, toRemove())
Dim chrItem As Variant

    For Each chrItem In toRemove()
        stString = Replace(stString, chrItem, "")
    Next
    toRemoveFromString = stString
End Function

用于清除即时窗口的仍然有缺陷的代码

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

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

2 个答案: