有關qrcode, 客戶要求 標籤貼紙內要有qrcode
目前 我用excel排版
用qrcode 產生程式 產生儲存成jpg後
在excel指位置貼上
這樣的做法 超廢工的
不知道有沒有方法可以 自動抓excel欄位資料後 生成qr codejpg貼在指定位置
謝謝
mikeok6336 wrote:
自動抓excel欄位資料後 生成qr codejpg貼在指定位置,...(恕刪)
像這樣嗎???
b1=qrcode(A1,ROW())
Function qrcode(qr, r)
if qr<>"" then
'因為google qrcode限制，中文需先轉成utf-8格式
'如果只有純英數，等號內的程式碼可以不要
'utf8string 用您要的文字取代就可以了 utf8string =qr
'如果是excel 2013以後的版本，就不用程式碼來轉，記得有一個函數可以轉成utf-8
'=========================================================
'利用jscript來縮短轉成utf-8的程式碼，(jscript只能用在excel 32位元)
Dim ScriptEngine As Object
Dim utf8string As String
Set ScriptEngine = CreateObject("scriptcontrol")
ScriptEngine.Language = "JScript"
utf8string = ScriptEngine.Run("encodeURIComponent", qr)
'==========================================================
'取得google qrcode產生的圖片，插入excel表格
Set q = ActiveSheet.Shapes.AddPicture("https://chart.googleapis.com/chart?chs=70x70&cht=qr&chl=" & utf8string, False, True, 1, 1, 1, 1)
'Set q = ActiveSheet.Pictures.Insert("https://chart.googleapis.com/chart?chs=70x70&cht=qr&chl=" & utf8string)
'調整圖片位置
With q
.Left = ActiveSheet.Cells(r, 2).Left
.Top = ActiveSheet.Cells(r, 2).Top
.Height = 100
.Width = 100
End With
end if
qrcode = ""
End Function
方法給您了，剩下的請自行改寫，如果不會，請您公司花錢找人寫吧，沒必要省這個
p.s 不要找我，最多就幫到這裡
'======================================================='
'20201113 因為有人問我線上版的問題，補一下excel 64位元轉碼範例
'excel 32、64位元範例(含中文轉碼)，使用方式
'(隨便找一格填入公式)=qrcode(A1,"50x50",ROW(),COLUMN())
'qrcode(文字來源位置,"長x寬",ROW(),COLUMN())，X 要小寫
'因為是利用google線上轉圖，所以速度會因網路而有所不同
'介意速度的話，請利用lib的離線版，可參考這篇
'(2017-01-10)
'https://www.mobile01.com/topicdetail.php?f=511&t=5037106&p=1#62998024
'或其它高手寫好的“無lib純vba”範例，可參考以下2個網址，有興趣可看看，但程式碼很長喔
'https://stackoverflow.com/questions/16143331/generating-2d-pdf417-or-qr-barcodes-using-excel-vba
'https://code.google.com/archive/p/barcode-vba-macro-only/downloads
Function qrcode(qr As String, Length_width As String, r As Integer, c As Integer)
Dim oldpic As Shape, check As Boolean
check = False
'del old pic
For Each oldpic In ActiveSheet.Shapes
If oldpic.TopLeftCell.Address = ActiveSheet.Cells(r, c).Address Then
check = True 'debug
oldpic.Delete
End If
Next
If qr <> "" Then
'add new pic
Set q = ActiveSheet.Shapes.AddPicture("https://chart.googleapis.com/chart?chs=" & Length_width & "&cht=qr&chl=" & UrlEncode(qr), False, True, 1, 1, 1, 1)
'Set q = ActiveSheet.Pictures.Insert("https://chart.googleapis.com/chart?chs=" & Length_width & "&cht=qr&chl=" & UrlEncode(qr))
With q
.Left = ActiveSheet.Cells(r, c).Left
.Top = ActiveSheet.Cells(r, c).Top
.Height = 100
.Width = 100
End With
End If
qrcode = ""
End Function
'下面這個因語法關係無法正確顯示，改用圖片，記得手動輸入
'(點我看大圖)
'如需其它編碼方式可參考這篇269樓(or 其它樓範例)後自行改寫
'https://www.mobile01.com/topicdetail.php?f=511&t=4737630
'=======================================================
客戶要求的qrcode 內容 不需要有中英文 ， 只要有數字即可 。。。。。。感謝 感謝 感謝
內文搜尋
從 APP 打開
X