Excel vba ou formule pour copier la valeur de plusieurs zones de texte activex dans des cellules adjacentes

Question

J'ai reçu un classeur contenant un grand nombre de zones de texte activex dans des colonnes dont les valeurs doivent être utilisées. Existe-t-il un moyen d'obtenir ces valeurs et de les placer dans la colonne à droite de chaque emplacement de boîte? Ils sont verrouillés et "se déplacent avec des cellules". Ils apparaissent dans le volet de sélection en tant que "HTMLText nnn". Il y a une valeur dans chaque zone de texte.

J'ai essayé de Kutools (merci à eux, the page), il semble que cela devrait fonctionner, mais rien ne se passe (pas de valeurs copiées, pas de boîtes supprimés):

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 

Merci!

Answer 1

Trouvé!

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