大家好！今天我要和大家分享一个非常实用的Excel技巧：如何使用VBA批量生成带有动态日期的二维码。这个方法特别适合需要批量处理数据并生成二维码的场景，比如菜谱管理、活动签到等。

背景

在日常工作中，我们常常需要生成带有特定信息的二维码，比如菜谱编号、日期等。手动一个个生成二维码不仅耗时，还容易出错。今天，我将通过VBA代码，实现批量生成二维码，并且可以根据用户输入的日期动态更新二维码内容。

准备工作

在开始之前，我们需要准备以下内容：

1. Excel表格：包含需要生成二维码的信息，例如菜谱名称、编号等。

2. 二维码生成API：这里Ai使用的是 [QR Code Server API](https://api.qrserver.com/v1/create-qr-code/)，它提供了一个简单的接口来生成二维码。

步骤1：设置Excel表格

假设我们的表格如下所示：

第三列（C列）是二维码的主要内容。

步骤2：编写VBA代码

打开Excel，按下 Alt + F11打开VBA编辑器，插入一个新模块，并粘贴以下代码：

代码如下

Sub GenerateQRCodes()

  Dim ws As Worksheet

  Set ws = ThisWorkbook.Sheets("Sheet1") ' 修改为您的表格名称

  Dim lastRow As Long

  lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' 假设菜谱名称在A列

  Dim qrContent As String

  Dim qrPath As String

  Dim desktopPath As String

  Dim folderPath As String

  Dim newDate As String

  ' 获取用户输入的日期

  newDate = InputBox("请输入新日期（格式：YYYY-MM-DD）：", "输入日期")

  If newDate = "" Then

    MsgBox "未输入日期，操作已取消！"

    Exit Sub

  End If

  ' 获取桌面路径

  desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")

  ' 创建以新日期命名的文件夹

  folderPath = desktopPath & "\炒制码_" & newDate

  ' 创建“炒制码”文件夹（如果不存在）

  If Dir(folderPath, vbDirectory) = "" Then

    MkDir folderPath

  End If

  ' 关闭屏幕更新和自动计算

  Application.ScreenUpdating = False

  Application.Calculation = xlCalculationManual

  ' 循环遍历每一行

  Dim i As Long

  For i = 2 To lastRow ' 假设第一行是标题

    ' 获取第三列（C列）的内容

    Dim colCContent As String

    colCContent = ws.Cells(i, "C").Value

    ' 获取第四列（D列）的日期

    Dim colDContent As String

    colDContent = ws.Cells(i, "D").Value

    ' 将第三列的内容与用户输入的日期合并

    qrContent = colCContent & "DATE:" & newDate & ";"

    ' 生成二维码图片路径

    qrPath = folderPath & "\" & ws.Cells(i, "A").Value & ".png" ' 菜谱名称命名

    ' 使用在线API生成二维码并保存

    Dim http As Object

    Set http = CreateObject("MSXML2.XMLHTTP")

    Dim url As String

    url = "https://api.qrserver.com/v1/create-qr-code/?data=" & qrContent & "&size=400x400&ecc=H" ' 30% 容错

    http.Open "GET", url, False

    http.send

    ' 保存二维码图片

    If http.Status = 200 Then

      Dim binaryStream As Object

      Set binaryStream = CreateObject("ADODB.Stream")

      binaryStream.Type = 1 ' adTypeBinary

      binaryStream.Open

      binaryStream.Write http.responseBody

      binaryStream.SaveToFile qrPath, 2 ' adSaveCreateOverwrite

      binaryStream.Close

    End If

  Next i

  ' 恢复屏幕更新和自动计算

  Application.ScreenUpdating = True

  Application.Calculation = xlCalculationAutomatic

  MsgBox "二维码已成功保存到桌面的“炒制码_" & newDate & "”文件夹中！"

End Sub

步骤3：运行代码

1. 保存Excel文件为宏启用的工作簿（`.xlsm`格式）。

2. 运行宏，输入新的日期，程序会自动替换第四列的日期，并生成二维码，保存到桌面的指定文件夹中。

效果展示

运行代码后，桌面会生成一个以输入日期命名的文件夹，里面包含了所有生成的二维码图片。每个二维码的内容都包含了用户输入的日期。

总结

通过这个简单的VBA代码，我们可以轻松实现批量生成带有动态日期的二维码。这种方法不仅节省时间，还能避免手动操作带来的错误。希望这个技巧能对大家有所帮助！

如果有任何问题或需要进一步的帮助，请随时留言。感谢观看！