複数のアクティブxテキストボックスの値を隣接セルにコピーするためのExcel vbaまたは数式

Question

使用する必要がある値の列にアクティブテキストボックスをたくさん載せたワークブックを受け取りました。 これらの値を取得し、各ボックス位置の右側の列に配置する方法はありますか？ これらはロックされており、「セルとともに移動」します。 選択ペインに「HTMLText nnn」と表示されます。 各テキストボックスには1つの値があります。

私は（the page、彼らにありがとう）、（値がまったくボックスが削除されていない、コピーされません）、それが動作するはずのように見えますが、何も起こりませんKutoolsからこれを試してみました：

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