news 2026/5/14 14:50:16

微软365Excel配合本地艺术二维码API在指定单元格动态生成二维码

作者头像

张小明

前端开发工程师

1.2k 24
文章封面图
微软365Excel配合本地艺术二维码API在指定单元格动态生成二维码

第一步:模块里放这个宏代码

Alt+F11→ 插入模块 → 粘贴:

Option Explicit ' 二维码固定尺寸(像素) Const QR_SIZE As Integer = 40 Sub 生成二维码() Dim ws As Worksheet Dim i As Long, lastRow As Long Dim url As String Dim qrCell As Range Dim tempPath As String Dim leftPos As Single, topPos As Single Set ws = ActiveSheet lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row tempPath = Environ("TEMP") & "\temp_qr_" & Environ("USERNAME") & ".png" ws.Columns("B").ColumnWidth = 10 ' 固定足够宽度,不挤压 ws.Rows(1 & ":" & lastRow).RowHeight = 60 ' 足够高度,居中不贴边 ' 清除B列所有旧二维码(防止重叠) DeleteAllQrShapes ws For i = 1 To lastRow If Trim(ws.Cells(i, "A").Value) <> "" Then url = "http://127.0.0.1:3000/api/qrcode?content=" & WorksheetFunction.EncodeURL(ws.Cells(i, "A").Value) ' 下载二维码 DownloadFile url, tempPath Set qrCell = ws.Cells(i, "B") leftPos = qrCell.Left + (qrCell.Width - QR_SIZE) / 2 topPos = qrCell.Top + (qrCell.Height - QR_SIZE) / 2 ' 插入二维码(固定尺寸、正正方形、不拉伸) With ws.Shapes.AddPicture( _ Filename:=tempPath, _ LinkToFile:=msoFalse, _ SaveWithDocument:=msoTrue, _ Left:=leftPos, _ Top:=topPos, _ Width:=QR_SIZE, _ Height:=QR_SIZE) .Name = "QR_" & i .LockAspectRatio = msoTrue ' 强制正方形 End With End If Next i If Dir(tempPath) <> "" Then Kill tempPath End Sub ' 辅助:删除B列所有旧二维码 Private Sub DeleteAllQrShapes(ws As Worksheet) On Error Resume Next Dim shp As Shape For Each shp In ws.Shapes If shp.Name Like "QR_*" Then shp.Delete Next On Error GoTo 0 End Sub ' 辅助:下载图片 Private Sub DownloadFile(url As String, savePath As String) Dim http As Object, stream As Object Set http = CreateObject("MSXML2.XMLHTTP.6.0") Set stream = CreateObject("ADODB.Stream") With http .Open "GET", url, False .send If .Status <> 200 Then MsgBox "? 接口请求失败,状态码:" & .Status, vbCritical Exit Sub End If End With With stream .Mode = 3 .Type = 1 .Open .Write http.responseBody .SaveToFile savePath, 2 .Close End With Set stream = Nothing Set http = Nothing End Sub


第二步:工作表代码实现「自动生成」

在VBA编辑器里,双击左侧你的工作表(比如Sheet1),粘贴下面这段代码:

Private Sub Worksheet_Change(ByVal Target As Range) ' 当A列内容变化时,自动重新生成二维码 If Not Intersect(Target, Me.Columns("A")) Is Nothing Then Application.ScreenUpdating = False Call 生成二维码 Application.ScreenUpdating = True End If End Sub


第三步:启动艺术二维码API服务


第四步:启动艺术二维码API服务

  1. 保存文件为「启用宏的工作簿(.xlsm)」格式。
  2. 运行一次宏,让B列自动调整单元格大小。
  3. 之后只要你修改A列的内容,B列的二维码就会自动刷新。


版权声明: 本文来自互联网用户投稿,该文观点仅代表作者本人,不代表本站立场。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如若内容造成侵权/违法违规/事实不符,请联系邮箱:809451989@qq.com进行投诉反馈,一经查实,立即删除!
网站建设 2026/5/14 14:50:15

Pearcleaner终极指南:如何在5分钟内彻底清理Mac残留文件

Pearcleaner终极指南&#xff1a;如何在5分钟内彻底清理Mac残留文件 【免费下载链接】Pearcleaner A free, source-available and fair-code licensed mac app cleaner 项目地址: https://gitcode.com/gh_mirrors/pe/Pearcleaner 还在为Mac电脑存储空间不足而烦恼吗&…

作者头像 李华
网站建设 2026/5/14 14:45:27

2026LinkedIn获客好友邀请受限怎么办?安全获客与防封的6个技巧

在 2026 年使用 LinkedIn 拓展客户时&#xff0c;“好友邀请受限”已经成为很多用户经常遇到的问题之一。无论是新账号&#xff0c;还是长期运营中的账号&#xff0c;都可能因为&#xff1a;邀请频率过高通过率偏低登录环境频繁变化操作行为异常而触发平台限制&#xff0c;影响…

作者头像 李华
网站建设 2026/5/14 14:45:26

TPT中实现等价类测试:提升汽车ECU测试效率与覆盖率

1. 项目概述&#xff1a;为什么等价类测试是高效测试的基石在嵌入式软件&#xff0c;尤其是汽车电子控制单元&#xff08;ECU&#xff09;的测试领域&#xff0c;我们常常面临一个核心矛盾&#xff1a;被测系统的输入空间理论上无限大&#xff0c;而测试资源和时间却极其有限。…

作者头像 李华
网站建设 2026/5/14 14:42:13

Gemini多模态资料理解的从demo到生产要补哪些能力

从工程用起来角度看&#xff0c;多模态不只看识别图片&#xff0c;它更适合处理截图、表格、PDF、PPT 和业务材料混在一起的理解任务。 聊 Gemini&#xff0c;不能只停在模型能力上。更实际的问题是&#xff0c;它能不能在“多模态资料处理”这类场景里跑出结果。第一次试 AI&…

作者头像 李华