VBA生成二维码如何插入Excel Database工作表G列最后一个单元格？

我现有一段VBA代码，可基于填写完成的用户窗体（userform）生成并插入二维码，当前二维码可正常插入，但无法将其放置到Database工作表G列的最后一个单元格中。用户窗体输入的信息均会存入该数据库工作表，我原计划通过查找最后一条数据条目、调用.offset方法定位目标位置，但始终无法运行成功，以下是我使用的代码：

Sub GenerateSingleQRCode()
Dim QRPic As String, QRURL As String, QRData As String, ForeCol As String, BackCol As String
Dim QRSize As Long, LastRow As Long, ItemRow As Long
Dim targetRow As Integer
Dim rngAnchor As Range
Dim Sh As Shape

With Worksheets("Database")
        
        On Error Resume Next
        .Shapes("QRItemPic").Delete
        On Error GoTo 0
        QRData = vbNewLine & "Part Number: " & txtPartNumber & vbNewLine & "Description: " & txtDescription & vbNewLine & "Supplier: " & txtSupplier & vbNewLine & "Product Line: " & partInfoProductLine  'Item Name (QR Data)
        QRSize = Worksheets("Setup").Range("C5").Value 'Large QR Size
        ForeCol = Right("00000" & Hex(Worksheets("Setup").Range("C4").Value), 6)
        ForeCol = Right(ForeCol, 2) & Mid(ForeCol, 3, 2) & Left(ForeCol, 2)
        BackCol = Right("00000" & Hex(Worksheets("Setup").Range("C3").Value), 6)
        BackCol = Right(BackCol, 2) & Mid(BackCol, 3, 2) & Left(BackCol, 2)
        QRURL = "https://api.qrserver.com/v1/create-qr-code/?data=" & QRData & "&size=" & QRSize & "x" & QRSize & _
        "&charset-source=UTF-8&charset-target-=UTF-8ecc=L&color=" & ForeCol & "&bgcolor=" & BackCol & _
        "&margin=0&qzone=1&format=png"
        With Worksheets("Database").Pictures.Insert(QRURL)
            
            
        End With
        End With
End Sub

修改方案 #

你原代码的核心问题是插入图片后没有配置位置属性，也没有提前定位G列的目标单元格，修改后的完整代码如下：

Sub GenerateSingleQRCode()
    Dim QRURL As String, QRData As String, ForeCol As String, BackCol As String
    Dim QRSize As Long, LastRow As Long
    Dim rngTarget As Range
    
    With Worksheets("Database")
        ' 删除之前的二维码，不需要可以删掉这段
        On Error Resume Next
        .Shapes("QRItemPic").Delete
        On Error GoTo 0
        
        ' 组装二维码内容
        QRData = vbNewLine & "Part Number: " & txtPartNumber & vbNewLine & "Description: " & txtDescription & vbNewLine & "Supplier: " & txtSupplier & vbNewLine & "Product Line: " & partInfoProductLine
        
        ' 读取二维码配置参数
        QRSize = Worksheets("Setup").Range("C5").Value
        ForeCol = Right("00000" & Hex(Worksheets("Setup").Range("C4").Value), 6)
        ForeCol = Right(ForeCol, 2) & Mid(ForeCol, 3, 2) & Left(ForeCol, 2)
        BackCol = Right("00000" & Hex(Worksheets("Setup").Range("C3").Value), 6)
        BackCol = Right(BackCol, 2) & Mid(BackCol, 3, 2) & Left(BackCol, 2)
        
        ' 生成二维码接口地址，修复了原参数的拼写错误避免乱码
        QRURL = "https://api.qrserver.com/v1/create-qr-code/?data=" & QRData & "&size=" & QRSize & "x" & QRSize & _
        "&charset-source=UTF-8&charset-target=UTF-8&ecc=L&color=" & ForeCol & "&bgcolor=" & BackCol & _
        "&margin=0&qzone=1&format=png"
        
        ' 查找最后一行数据，默认按A列判断，可替换为你表中不会为空的列
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        ' 定位G列对应最后一行的目标单元格
        Set rngTarget = .Cells(LastRow, "G")
        
        ' 插入二维码并设置位置
        With .Pictures.Insert(QRURL)
            ' 左上角对齐目标单元格
            .Top = rngTarget.Top
            .Left = rngTarget.Left
            ' 可选：设置二维码和单元格尺寸一致，不需要可以注释掉
            .Height = rngTarget.Height
            .Width = rngTarget.Width
            ' 设置图片随单元格移动调整
            .Placement = xlMoveAndSize
            ' 给图片命名方便后续操作
            .Name = "QRItemPic"
        End With
    End With
End Sub

注意事项 #

• 如果你的表中A列可能为空，可以把查找最后一行代码里的"A"替换为你实际不会为空的列，比如序号列或者零件号列
• 如果你是刚写入完新行数据就调用这个生成二维码的方法，要确保写入操作已经完成再执行找最后一行的代码，避免定位到上一行

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