HTMLText 取值

如果还有其它控件:
    Dim i As Integer, k As Integer
    With Sheet2
        For i = 1 To .OLEObjects.Count
            If .OLEObjects(i).Name Like "HTMLText*" Then k = k + 1
        Next
        For i = 1 To k
            .Cells(i, 2) = .OLEObjects(("HTMLText" & i).Object.Value
        Next
    End With

如果没有其它控件:
    Dim i As Integer
    With Sheet2
        For i = 1 To .OLEObjects.Count
            .Cells(i, 2) = .OLEObjects(i).Object.Value
        Next
    End With

Sub Macro1()
    Dim sh As Worksheet, T As Shape, r As ShapeRange, n As Long
    Set sh = ActiveSheet
    For Each T In sh.Shapes
        If T.Name Like "HTMLText*" Then
            Debug.Print T.Name; vbTab;
            T.Copy
            sh.Paste
            Selection.ShapeRange.Ungroup.Select
            Selection.ShapeRange.Ungroup.Select
            n = Selection.ShapeRange.Count
            Debug.Print Selection.ShapeRange(n).TextFrame.Characters.Text
            Selection.Delete
        End If
    Next
End Sub

Sub 取值1()
Dim ole As OLEObject

i = 8
h = 2
x = 1

For Each ole In OLEObjects
  If (TypeName(ole.Object)) Like "*HTMLText*" Then

      Cells(h, i) = ole.Object.Value
      Cells(h, i - 1) = x
      h = h + 1
      x = x + 1

  End If
Next
End Sub