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