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

问题描述：

我收到了一个带有大量activex文本框的工作簿，其中包含需要使用的值的列。有没有办法获得这些值并将它们放在每个方块位置右侧的列中？他们被锁定并“随细胞移动”。它们作为“HTMLText nnn”出现在选择窗格中。每个文本框中都有一个值。Excel vba或公式将多个activex文本框的值复制到相邻单元格

我从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

谢谢！

答

找到了！

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文本框的值复制到相邻单元格

相关推荐