wps excel指定数据区域，二维码生成区域，批量生成单元格二维码VBA宏代码

1、ALT+F11；

选定要使用VBA宏的表格子页
2、粘贴代码

bash 复制代码
Sub 批量生成二维码()
    Dim srcRng As Range, tgtRng As Range
    Dim cell As Range
    Dim qrUrl As String
    
    ' 1. 弹出对话框，让用户手动选择需要生成二维码的【数据源区域】
    On Error Resume Next
    Set srcRng = Application.InputBox("第一步：请用鼠标框选需要生成二维码的【数据区域】：", "选择数据列", Type:=8)
    On Error GoTo 0
    
    ' 如果用户点击了取消，则退出程序
    If srcRng Is Nothing Then
        MsgBox "操作已取消！", vbInformation
        Exit Sub
    End If
    
    ' 2. 弹出对话框，让用户手动选择二维码生成的【目标区域】
    On Error Resume Next
    Set tgtRng = Application.InputBox("第二步：请用鼠标框选二维码要插入的【目标区域】（行数需与数据区域一致）：", "选择目标列", Type:=8)
    On Error GoTo 0
    
    ' 如果用户点击了取消，则退出程序
    If tgtRng Is Nothing Then
        MsgBox "操作已取消！", vbInformation
        Exit Sub
    End If
    
    ' 3. 校验两个区域的大小是否一致
    If srcRng.Rows.Count <> tgtRng.Rows.Count Then
        MsgBox "错误：数据区域和目标区域的行数不一致，请重新运行！", vbCritical
        Exit Sub
    End If
    
    ' 4. 遍历数据源区域，生成二维码并插入到目标区域
    Dim i As Long
    For i = 1 To srcRng.Rows.Count
        ' 获取数据源单元格和目标单元格
        Dim dataCell As Range, targetCell As Range
        Set dataCell = srcRng.Cells(i, 1)
        Set targetCell = tgtRng.Cells(i, 1)
        
        ' 判断单元格是否为空
        If Trim(dataCell.Value) <> "" Then
            ' 拼接二维码生成API地址
            qrUrl = "https://api.qrserver.com/v1/create-qr-code/?size=120x120&data=" & dataCell.Value
            
            ' 在目标单元格插入二维码图片
            On Error Resume Next
            ActiveSheet.Pictures.Insert(qrUrl).Select
            On Error GoTo 0
            
            ' 设置图片的位置和大小，使其适配目标单元格
            With Selection
                .Top = targetCell.Top + 2      ' 留出2像素边距
                .Left = targetCell.Left + 2
                .ShapeRange.LockAspectRatio = msoTrue ' 锁定纵横比，防止变形
                .Height = 60                          ' 设置高度为60
            End With
        End If
    Next i
    
    MsgBox "二维码批量生成完成！", vbInformation
End Sub