vba parse错误

'Sub getpicture()
'Dim d, i&, sp As Shape, arr
'Set d = CreateObject("scripting.dictionary")
'For Each sp In Sheet1.Shapes
'   If sp.Type = msoPicture Then
'      Set d(sp.TopLeftCell.Offset(, -1).Value) = sp
'   End If
'Next
'arr = Sheets(2).Range([a2], [a65536].End(3))
'For i = 1 To UBound(arr)
'   If d.exists(arr(i, 1)) Then
'      d(arr(i, 1)).Copy
'      Cells(i + 1, 2).Select
'      ActiveSheet.Paste
'   End If
'Next
'ActiveWindow.ScrollRow = 1
'
'End Sub
' windows api
Private Declare Function timeGetTime Lib "winmm.dll" () As Long

' sleep(毫秒)
Sub sleep(T As Long)
    Dim time1 As Long
    time1 = timeGetTime
    Do
        DoEvents
    Loop While timeGetTime - time1 < T
End Sub


Sub getpicture()
Dim d, i&, sp As Shape, arr, xb As Workbook

'设置图片库数组
Set xb = GetObject(ActiveWorkbook.path & "\图片库.xlsx")
'Set xb = GetObject("C:\图片库.xlsx")
Set d = CreateObject("scripting.dictionary")
For Each sp In xb.Sheets(1).Shapes
   If sp.Type = msoPicture Then
      Set d(sp.TopLeftCell.Offset(, -1).Value) = sp
   End If
Next

'读取首行
Dim y As Double
y = Selection.Column() '列数

arr = ActiveSheet.Range(Cells(1, y - 1), Cells(65536, y - 1).End(3))
For i = 1 To UBound(arr)
   If d.exists(arr(i, 1)) Then
      sleep 100
      d(arr(i, 1)).Copy
      Cells(i, y).Select
      On Error Resume Next
      ActiveSheet.Paste
   End If
Next
ActiveWindow.ScrollRow = 1

End Sub

Sub deletepicture()
Dim Tupian As Shape
        For Each Tupian In ActiveSheet.Shapes
            If Tupian.Name Like "Picture *" Then Tupian.Delete
        Next

End Sub

Sub 工具栏()
With Application.CommandBars.Add(, , , True)
With .Controls.Add
     .Caption = "匹配图片"
     .TooltipText = "匹配图片"
     .OnAction = "getpicture"
     .Style = msoButtonIconAndCaption
    End With
    .Visible = True
    
    With .Controls.Add
     .Caption = "清除图片"
     .TooltipText = "清除图片"
     .OnAction = "deletepicture"
     .Style = msoButtonIconAndCaption
    End With
    .Visible = True
    End With
   
End Sub