- 帖子
- 438
- 主題
- 67
- 精華
- 0
- 積分
- 531
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- office 2010
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2012-10-30
- 最後登錄
- 2025-5-28
|
3#
發表於 2024-6-15 12:37
| 只看該作者
請教VBA製造Bar Code：
在Data 表内 根據 欄B 至 欄 H （暫定H, 可能會更多欄數）的資料，每行製造 ...
198188 發表於 2024-6-13 15:26 
分享初步結果- Sub Make_BarCode()
- Dim i, j As Integer
- With Worksheets("Data")
- j = Range("C1").End(xlDown).Row
- For i = 2 To j
- Range("A" & i).Select
- 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
- With ActiveSheet.Pictures.Insert(filepath)
- H1 = .TopLeftCell.Height
- H2 = .Height
- .Top = .TopLeftCell.Top + (H1 - H2) / 2
- H1 = .TopLeftCell.Width
- H2 = .Width
- .Left = .TopLeftCell.Left + (H1 - H2) / 2
- End With
-
- Range("B" & i) = "*" & Range("C" & i) & "*"
- Range("B" & i).Font.Name = "Bar-Code 39"
- Range("B" & i).Font.Size = "25"
- Next i
- End With
- End Sub
- Sub Remove_QR_Code()
- Dim i, j As Integer
- With Worksheets("Data")
- For Each pic In ActiveSheet.Pictures
- pic.Delete
- Next pic
- j = Range("B1").End(xlDown).Row
- For i = 2 To j
- Range("B" & i) = ""
- Range("B" & i).Font.Name = "Calibri"
- Next i
- End With
- End Sub
|
|
