Snasui Excel Forum

Code: Select all

Sub HtmlSelect()
    Dim obj As Object, i As Integer, j As Integer
    Dim a As Variant, b As Variant, c(0, 2) As Variant
    With Sheets(1)
        For Each obj In .Shapes
            If Left(obj.Name, 4) = "HTML" Then
                a = Split(obj.DrawingObject.Object.DisplayValues, ";")                      '1 Display value if Data is value Q:What is ";"
                b = Split(obj.DrawingObject.Object.Selected, ";")                           '2 Detect Object is Selected or Data value Q:What is .selected
                i = Application.Match("True", b, 0) - 1                                     '3 Convert True to 0 false to 1 Q:Why match false not error
                With Sheets("Sheet2")
                    If j = 0 Then                                                           '4 If J is unidentify represent to 0, right?
                        'If .Range("a1") = "" Then                                          'not use
                        .Range("a1").Value = a(i)                                           '5 a is array in object 1, right
                        'Else
                            '.Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Value = a(i)  'not use
                        'End If
                    Else
                        c(0, j - 1) = a(i)
                    End If
                End With
                j = j + 1
            End If
        Next obj
        With Sheets("sheet2")
            .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 3).Value = c
        End With
    End With
End Sub

Code: Select all

Sub HtmlSelect()
    'Sheets("Sheet2").Range("A1") = Shapes.Range(Array("HTMLSelect1")).Value
    Dim obj As Object, i As Integer, j As Integer
    Dim a As Variant, b As Variant, c(0, 2) As Variant
    With Sheets(1)
        For Each obj In .Shapes
            If Left(obj.Name, 4) = "HTML" Then
                a = Split(obj.DrawingObject.Object.DisplayValues, ";")
                b = Split(obj.DrawingObject.Object.Selected, ";")
                i = Application.Match("True", b, 0) - 1
                With Sheets("Sheet2")
                    If j = 0 Then
                        If .Range("a1") = "" Then
                            .Range("a1").Value = a(i)
                        Else
                            .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Value = a(i)
                        End If
                    Else
                        c(0, j - 1) = a(i)
                    End If
                End With
                j = j + 1
            End If
        Next obj
        With Sheets("sheet2")
            .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 3).Value = c
        End With
    End With
End Sub