word/excel/cad中插入二维码

Posted 2020-10-13 于天云

1.有需求为在word文档中插入二维码，寻访度娘后，大部分人推荐使用QRmaker制作。

2.找寻QRmaker，网上很多都是1.1版本，后来才知道这个版本有问题（对中文支持不好），偶然得到1.3的版本，用起来很不错，完美中文。

下载链接: https://pan.baidu.com/s/1cEYBFK 密码: eubg

3.解压，点击控件注册，打开一个word文档，通过控件（度娘控件开启方式）插入QRmaker，再插入一个button，button执行代码如下：

//转换UTF-8编码，

Option Explicit
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
Private Const CP_UTF8 = 65001

Public Function UTF8_Encode(ByVal strUnicode As String) As Byte() \'UTF-8 编码
Dim TLen As Long
Dim lngBufferSize As Long
Dim lngResult As Long
Dim bytUtf8() As Byte
TLen = Len(strUnicode)
If TLen = 0 Then Exit Function
lngBufferSize = TLen * 3 + 1
ReDim bytUtf8(lngBufferSize - 1)
lngResult = WideCharToMultiByte(CP_UTF8, 0, StrPtr(strUnicode), TLen, bytUtf8(0), lngBufferSize, vbNullString, 0)
If lngResult <> 0 Then
lngResult = lngResult - 1
ReDim Preserve bytUtf8(lngResult)
End If
UTF8_Encode = bytUtf8
End Function

Private Sub button_Click()
Dim i, j As Integer
Dim n, m, p, q As String
\'.Const fileName As String = "C:\\AAAA.bmp"
m = ActiveDocument.Fields(1).Result \'文件编号
n = ActiveDocument.Fields(2).Result \'版本
p = ActiveDocument.Fields(3).Result \'修改
q = ActiveDocument.Fields(4).Result \'文件名称
With QRmaker1
\'.Refresh
.InputDataB = UTF8_Encode(m + "_" + n + "." + p + vbCrLf + q) \'输出二维码
\',i = .CreateQrMetaFile(1, fileName, 2)
.QrImageCopy (1)
.Height = 1
.Width = 1
End With
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.Paste
End Sub 

4.搞定！

PS：CAD中插入二维码需要下载一个控件CAD_QRCode_For_AutoCAD2004_2014.exe

下载链接: https://pan.baidu.com/s/1c13iY4o 密码: eivv

以上程序及工具来源于网上，如有权限要求，请在下文留言，谢谢。