如何在Excel本地通过宏将指定单元格值转为二维码并定位放置？

针对你依赖在线API生成二维码被限制的问题，以下是两种完全本地运行的VBA解决方案，无需调用外部接口：

方案一：使用Office自带的Microsoft QR Code控件 #

这个控件是Office原生组件，无需额外安装，操作步骤如下：

1. 启用控件

   • 打开Excel，按Alt+F11进入VBA编辑器
   • 点击菜单栏【工具】→【引用】，勾选Microsoft QR Code Control 6.0；如果找不到，切换到Excel界面，通过【开发工具】→【附加控件】找到并添加该控件

2. 替换原代码的实现
   下面的代码会删除现有图片，然后在指定位置生成二维码，完全匹配你原代码的布局逻辑：

   Sub addQR_Local()
       Dim qrCtrl As Object
       Dim targetRng As Range
       
       ' 删除现有图片和二维码控件
       For Each shp In ActiveSheet.Shapes
           If shp.Type = msoPicture Or shp.Name Like "QRCode*" Then
               shp.Delete
           End If
       Next shp
       
       ' 生成第一个二维码：对应Cells(3,18)，放置到I1附近
       Set qrCtrl = CreateObject("Microsoft.QRCode")
       qrCtrl.Data = Cells(3, 18).Value
       Set targetRng = ActiveSheet.Range("I1")
       With ActiveSheet.Shapes.AddPicture(qrCtrl.Picture, False, True, targetRng.Left, targetRng.Top, targetRng.Width * 2, targetRng.Height * 5)
           .Name = "QRCode_1"
           .Placement = 1
       End With
       
       ' 生成第二个二维码：对应Cells(5,18)，放置到G11
       Set qrCtrl = CreateObject("Microsoft.QRCode")
       qrCtrl.Data = Cells(5, 18).Value
       Set targetRng = ActiveSheet.Range("G11")
       With ActiveSheet.Shapes.AddPicture(qrCtrl.Picture, False, True, targetRng.Left, targetRng.Top, targetRng.Width * 2, targetRng.Height * 5)
           .Name = "QRCode_2"
           .Placement = 1
       End With
       
       ' 生成第三个二维码：对应Cells(7,18)，放置到E21
       Set qrCtrl = CreateObject("Microsoft.QRCode")
       qrCtrl.Data = Cells(7, 18).Value
       Set targetRng = ActiveSheet.Range("E21")
       With ActiveSheet.Shapes.AddPicture(qrCtrl.Picture, False, True, targetRng.Left, targetRng.Top, targetRng.Width * 2, targetRng.Height * 5)
           .Name = "QRCode_3"
           .Placement = 1
       End With
       
       ' 生成第四个二维码：对应Cells(9,18)，放置到L21
       Set qrCtrl = CreateObject("Microsoft.QRCode")
       qrCtrl.Data = Cells(9, 18).Value
       Set targetRng = ActiveSheet.Range("L21")
       With ActiveSheet.Shapes.AddPicture(qrCtrl.Picture, False, True, targetRng.Left, targetRng.Top, targetRng.Width * 2, targetRng.Height * 5)
           .Name = "QRCode_4"
           .Placement = 1
       End With
       
       ' 插入logo图片（保留原逻辑）
       picPath = "O:\Robin\Dokument\logga.jpg"
       With ActiveSheet.Pictures.Insert(picPath)
           .ShapeRange.LockAspectRatio = msoFalse
           .ShapeRange.ScaleWidth 1.78, msoFalse, msoScaleFromTopLeft
           .ShapeRange.ScaleHeight 1.24, msoFalse, msoScaleFromTopLeft
           .Left = ActiveSheet.Range("B3").Left
           .Top = ActiveSheet.Range("B3").Top
           .Placement = 1
       End With
       
       Set qrCtrl = Nothing
       Set targetRng = Nothing
   End Sub
   

方案二：使用ZXing VBA库（更灵活的自定义选项） #

如果需要自定义二维码的纠错级别、尺寸、边距等参数，推荐使用ZXing的VBA移植版本：

1. 导入ZXing模块

   • 下载ZXing-VBA的模块代码后，打开VBA编辑器，右键插入模块，将代码粘贴进去

2. 实现本地生成逻辑

   Sub addQR_ZXing()
       Dim qrImage As Object
       Dim targetRng As Range
       Dim qrSize As Integer
       qrSize = 120 ' 二维码基础尺寸，可根据需求调整
       
       ' 删除现有图片
       For Each pic In ActiveSheet.Pictures
           pic.Delete
       Next pic
       
       ' 生成第一个二维码
       Set qrImage = GenerateQRCode(Cells(3, 18).Value, qrSize)
       Set targetRng = ActiveSheet.Range("I1")
       With ActiveSheet.Shapes.AddPicture(qrImage, False, True, targetRng.Left, targetRng.Top, targetRng.Width, targetRng.Height)
           .Placement = 1
       End With
       
       ' 生成第二个二维码
       Set qrImage = GenerateQRCode(Cells(5, 18).Value, qrSize)
       Set targetRng = ActiveSheet.Range("G11")
       With ActiveSheet.Shapes.AddPicture(qrImage, False, True, targetRng.Left, targetRng.Top, targetRng.Width, targetRng.Height)
           .Placement = 1
       End With
       
       ' 生成第三个二维码
       Set qrImage = GenerateQRCode(Cells(7, 18).Value, qrSize)
       Set targetRng = ActiveSheet.Range("E21")
       With ActiveSheet.Shapes.AddPicture(qrImage, False, True, targetRng.Left, targetRng.Top, targetRng.Width, targetRng.Height)
           .Placement = 1
       End With
       
       ' 生成第四个二维码
       Set qrImage = GenerateQRCode(Cells(9, 18).Value, qrSize)
       Set targetRng = ActiveSheet.Range("L21")
       With ActiveSheet.Shapes.AddPicture(qrImage, False, True, targetRng.Left, targetRng.Top, targetRng.Width, targetRng.Height)
           .Placement = 1
       End With
       
       ' 插入logo图片（保留原逻辑）
       picPath = "O:\Robin\Dokument\logga.jpg"
       With ActiveSheet.Pictures.Insert(picPath)
           .ShapeRange.LockAspectRatio = msoFalse
           .ShapeRange.ScaleWidth 1.78, msoFalse, msoScaleFromTopLeft
           .ShapeRange.ScaleHeight 1.24, msoFalse, msoScaleFromTopLeft
           .Left = ActiveSheet.Range("B3").Left
           .Top = ActiveSheet.Range("B3").Top
           .Placement = 1
       End With
       
       Set qrImage = Nothing
       Set targetRng = Nothing
   End Sub
   
   ' 调用ZXing生成二维码的辅助函数
   Function GenerateQRCode(data As String, size As Integer) As StdPicture
       Dim writer As New BarcodeWriter
       Dim bitmap As Object
       With writer
           .Format = CODE_QR_CODE
           .Options.ErrorCorrection = ErrorCorrectionLevel.H ' 高纠错级别
           .Options.Width = size
           .Options.Height = size
           .Options.Margin = 1
       End With
       Set bitmap = writer.Write(data)
       Set GenerateQRCode = BitmapToPicture(bitmap)
       Set bitmap = Nothing
       Set writer = Nothing
   End Function
   

注意事项 #

• 方案一的控件在部分Office版本中可能默认隐藏，需手动启用；若无法找到该控件，直接使用方案二即可。
• 方案二导入模块后，需确保VBA编辑器中已引用StdPicture相关对象。
• 两种方案均完全本地运行，不会触发在线API的反垃圾拦截限制。

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