返回列表 上一主題 發帖

請教VBA製造Bar Code

請教VBA製造Bar Code

barcode.jpg
2024-6-13 15:20

請教VBA製造Bar Code:
在Data 表内 根據 欄B 至 欄 H (暫定H, 可能會更多欄數)的資料,每行製造一個唯一的二維碼,如左邊欄A。
當掃描左邊欄A的二維碼后,會顯示圖片右邊紅色的資料。

BARCODE.rar (18.84 KB)

請教VBA製造Bar Code:
在Data 表内 根據 欄B 至 欄 H (暫定H, 可能會更多欄數)的資料,每行製造 ...
198188 發表於 2024-6-13 15:26



讀取單一儲存格資料懂得如何操作,如果不想將多個儲存格的資料,合并在一個儲存格内。
是否可以同時讀取多個儲存格資料?

TOP

請教VBA製造Bar Code:
在Data 表内 根據 欄B 至 欄 H (暫定H, 可能會更多欄數)的資料,每行製造 ...
198188 發表於 2024-6-13 15:26


分享初步結果
  1. Sub Make_BarCode()
  2. Dim i, j As Integer
  3. With Worksheets("Data")
  4. j = Range("C1").End(xlDown).Row
  5. For i = 2 To j
  6. Range("A" & i).Select
  7. filepath = "https://api.qrserver.com/v1/create-qr-code/?size=95x95&data=" & Range("C1").Value & ":" & Range("C" & i).Value & vbLf & Range("D1").Value & ":" & Range("D" & i).Value & vbLf & Range("E1").Value & ":" & Range("E" & i).Value & vbLf & Range("F1").Value & ":" & Range("F" & i).Value & vbLf & Range("G1").Value & ":" & Range("G" & i).Value & vbLf & Range("H1").Value & ":" & Range("H" & i).Value & vbLf & Range("I1").Value & ":" & Range("I" & i).Value & vbLf & Range("J1").Value & ":" & Range("J" & i).Value & vbLf & Range("K1").Value & ":" & Range("K" & i).Value & vbLf & Range("L1").Value & ":" & Range("L" & i).Value & vbLf & Range("M1").Value & ":" & Range("M" & i).Value
  8. With ActiveSheet.Pictures.Insert(filepath)

  9.             H1 = .TopLeftCell.Height
  10.             H2 = .Height
  11.             .Top = .TopLeftCell.Top + (H1 - H2) / 2
  12.             H1 = .TopLeftCell.Width
  13.             H2 = .Width
  14.             .Left = .TopLeftCell.Left + (H1 - H2) / 2
  15.         End With
  16.    

  17. Range("B" & i) = "*" & Range("C" & i) & "*"
  18. Range("B" & i).Font.Name = "Bar-Code 39"
  19. Range("B" & i).Font.Size = "25"

  20. Next i
  21. End With
  22. End Sub


  23. Sub Remove_QR_Code()
  24. Dim i, j As Integer

  25. With Worksheets("Data")
  26. For Each pic In ActiveSheet.Pictures
  27. pic.Delete
  28. Next pic

  29. j = Range("B1").End(xlDown).Row

  30. For i = 2 To j
  31. Range("B" & i) = ""
  32. Range("B" & i).Font.Name = "Calibri"
  33. Next i
  34. End With

  35. End Sub
複製代碼

BarCodeTest.rar (29.22 KB)

TOP

        靜思自在 : 【為善競爭】人生要為善競爭,分秒必爭。
返回列表 上一主題