VBA插入二维码时Selection.ShapeRange.Item(1)报对象不支持属性错误如何解决

• 代码依赖Selection对象获取插入的图片，批量处理过程中Excel界面重绘延迟、插入图片失败、活动对象变化等情况都会导致Selection不是图片对象，访问ShapeRange属性就会触发报错。
• 未直接捕获Pictures.Insert方法返回的图片对象，绕弯通过Selection取值本身就存在稳定性问题。
• 单元格引用未明确绑定工作表，活动工作表变化时会出现定位错误。

' 建议在循环开头关闭屏幕更新提升稳定性
Application.ScreenUpdating = False
On Error Resume Next

For i = 6 To Sheet2.Range("D" & Application.Rows.Count).End(xlUp).Row
    Application.StatusBar = i - 1 & "/" & Sheet2.Range("D" & Application.Rows.Count).End(xlUp).Row - 1
    bot.FindElementByXPath("//input[contains(@type,'search')]").SendKeys (Sheet2.Range("D" & i))
    bot.Wait 1500
    Report = bot.FindElementByLinkText("EN").Attribute("href")
    bot.Get Report
    bot.Wait 1500
    QRurl = bot.FindElementByXPath("//img[contains(@src,'QRimages')]").Attribute("src")
    Sheet2.Range("Z" & i).Value = QRurl
    
    Dim Pshp As Picture
    Set Pshp = Sheet2.Pictures.Insert(QRurl)
    ' 等待图片插入完成
    DoEvents
    
    If Not Pshp Is Nothing Then
        xcol = Sheet2.Range("Z" & i).Column - 1
        Set xRg = Sheet2.Cells(Sheet2.Range("Z" & i).Row, xcol)
        With Pshp
            .LockAspectRatio = msoFalse
            If .Width > xRg.Width Then .Width = xRg.Width * 0.9
            If .Height > xRg.Height Then .Height = xRg.Height * 0.9
            .Top = xRg.Top + (xRg.Height - .Height) / 2
            .Left = xRg.Left + (xRg.Width - .Width) / 2
            .Placement = xlMoveAndSize
        End With
    End If
    Set Pshp = Nothing
    
    bot.Get "https://_/_/bulk_upload2_record.php"
    bot.Wait 1000
Next i

' 恢复环境设置
Application.ScreenUpdating = True
Application.StatusBar = False
On Error GoTo 0

• 彻底移除了所有Select、Selection相关的不稳定操作，直接用变量接收Pictures.Insert返回的图片对象，从根源上避免对象属性不支持的报错。
• 增加DoEvents等待Excel完成图片插入操作，避免异步加载导致的对象不存在问题。
• 所有单元格引用都明确绑定Sheet2，不会因为活动工作表切换出现定位错误。
• 增加了环境设置恢复逻辑，代码运行结束后不会影响Excel的正常使用。
• 如果仍偶发插入失败，可适当延长bot.Wait的等待时长，保证二维码链接拉取成功后再执行插入操作。

内容的提问来源于stack exchange，提问作者user16717362