Excel VBA 或公式将多个 ActiveX 文本框的值复制到相邻单元格

Question

我收到了一个工作簿，其中包含我需要使用的值的列中的大量 ActiveX 文本框。有没有办法获取这些值并将它们放在每个框位置右侧的列中？

它们被锁定并“随细胞移动”。它们在选择窗格中显示为“HTMLText nnn”。每个文本框中有一个值。

我已经在 Kutools 上试过了（谢谢他们，the page），看起来应该可以，但什么也没发生（没有复制值，没有删除框）：

Sub TextboxesToCell_Kutools()

    Dim xRg As Range
    Dim xRow As Long
    Dim xCol As Long
    Dim xTxtBox As TextBox
     
    Set xRg = Application.InputBox("Select a cell):", "Kutools for Excel", _
        ActiveWindow.RangeSelection.AddressLocal, , , , , 8)
    xRow = xRg.Row
    xCol = xRg.Column
     
    For Each xTxtBox In ActiveSheet.TextBoxes
        Cells(xRow, xCol).Value = xTxtBox.text
        xTxtBox.Delete
        xRow = xRow + 1
    Next
     
End Sub

Answer 1

找到了！

    Sub H___CopyFormsHTMLBoxToSameCell()
'https://windowssecrets.com/forums/showthread.php/169760-Text-box-value-from-a-web-page-copy-and-paste (modified)

Dim OLEObj As OLEObject 'from the control toolbox toolbar
Dim DestCell As Range
Dim wks As Worksheet
Set wks = ActiveSheet

With wks
    For Each OLEObj In .OLEObjects
        If TypeOf OLEObj.Object Is msforms.TextBox Then
            Set DestCell = OLEObj.TopLeftCell.Offset(0, 0)
            DestCell.Value = OLEObj.Object.Value
             OLEObj.Delete 'vp added
'    ActiveCell.Activate doesnt center cell!

        End If
    Next OLEObj
End With

MsgBox "Done. Home, find, selection pane check for other shapes; f5, objects, Ctrl-click unselect pictures, delete."

End Sub

Excel VBA 或公式将多个 ActiveX 文本框的值复制到相邻单元格

Excel VBA or formula to copy value of multiple ActiveX text box to adjacent cells

excel

vba

textbox

copy-paste