huonglypolice
Thành viên mới
- Tham gia
- 10/10/08
- Bài viết
- 14
- Được thích
- 0
Em có Module tạo QR Code trong sheet "BB" nhưng VBA lại chỉ sinh thêm ra ảnh để quét mã vạch cho riêng từng đơn hàng khi in ra_ảnh đè lên nhau, mà ko xóa đi khi có dữ liệu mới (Khi thay đổi số thứ tự ở ô G3 thì các ô khác thay đổi)
Nên càng ngày càng nặng file hoặc phải xóa thủ công.
Đoạn code dưới chạy đang khá ổn nhưng đang bị vướng mắc vấn đề trên.
Anh chị nào có kinh nghiệm mảng này rùi thì xử lý giúp em với nhé.
Em xin cảm ơn rất nhiều ạ.
Chi tiết như file đính kèm ạ.
Option Explicit
'other technical specifications about google chart API:
'https://developers.google.com/chart/infographics/docs/qr_codes
Function URL_QRCode_SERIES( _
ByVal PictureName As String, _
ByVal QR_Value As String, _
Optional ByVal PictureSize As Long = 60, _
Optional ByVal DisplayText As String = "", _
Optional ByVal Updateable As Boolean = True) As Variant
Dim oPic As Shape, oRng As Excel.Range
Dim vLeft As Variant, vTop As Variant
Dim sURL As String
Const sRootURL As String = "https://chart.googleapis.com/chart?"
Const sSizeParameter As String = "chs="
Const sTypeChart As String = "chld=H&cht=qr"
Const sDataParameter As String = "chl="
Const sJoinCHR As String = "&"
If Updateable = False Then
URL_QRCode_SERIES = "outdated"
Exit Function
End If
Set oRng = Application.Caller.Offset(, 1)
On Error Resume Next
Set oPic = oRng.Parent.Shapes(PictureName)
If Err Then
Err.Clear
vLeft = oRng.Left + 4
vTop = oRng.Top
Else
vLeft = oPic.Left
vTop = oPic.Top
PictureSize = Int(oPic.Width)
End If
On Error GoTo 0
If Len(QR_Value) = 0 Then
URL_QRCode_SERIES = CVErr(xlErrValue)
Exit Function
End If
sURL = sRootURL & _
sSizeParameter & PictureSize & "x" & PictureSize & sJoinCHR & _
sTypeChart & sJoinCHR & _
sDataParameter & VBA.Replace(QR_Value, " ", "+")
Set oPic = oRng.Parent.Shapes.AddPicture(sURL, True, True, vLeft, vTop, PictureSize, PictureSize)
oPic.Name = PictureName
URL_QRCode_SERIES = DisplayText
End Function
Nên càng ngày càng nặng file hoặc phải xóa thủ công.
Đoạn code dưới chạy đang khá ổn nhưng đang bị vướng mắc vấn đề trên.
Anh chị nào có kinh nghiệm mảng này rùi thì xử lý giúp em với nhé.
Em xin cảm ơn rất nhiều ạ.
Chi tiết như file đính kèm ạ.
Option Explicit
'other technical specifications about google chart API:
'https://developers.google.com/chart/infographics/docs/qr_codes
Function URL_QRCode_SERIES( _
ByVal PictureName As String, _
ByVal QR_Value As String, _
Optional ByVal PictureSize As Long = 60, _
Optional ByVal DisplayText As String = "", _
Optional ByVal Updateable As Boolean = True) As Variant
Dim oPic As Shape, oRng As Excel.Range
Dim vLeft As Variant, vTop As Variant
Dim sURL As String
Const sRootURL As String = "https://chart.googleapis.com/chart?"
Const sSizeParameter As String = "chs="
Const sTypeChart As String = "chld=H&cht=qr"
Const sDataParameter As String = "chl="
Const sJoinCHR As String = "&"
If Updateable = False Then
URL_QRCode_SERIES = "outdated"
Exit Function
End If
Set oRng = Application.Caller.Offset(, 1)
On Error Resume Next
Set oPic = oRng.Parent.Shapes(PictureName)
If Err Then
Err.Clear
vLeft = oRng.Left + 4
vTop = oRng.Top
Else
vLeft = oPic.Left
vTop = oPic.Top
PictureSize = Int(oPic.Width)
End If
On Error GoTo 0
If Len(QR_Value) = 0 Then
URL_QRCode_SERIES = CVErr(xlErrValue)
Exit Function
End If
sURL = sRootURL & _
sSizeParameter & PictureSize & "x" & PictureSize & sJoinCHR & _
sTypeChart & sJoinCHR & _
sDataParameter & VBA.Replace(QR_Value, " ", "+")
Set oPic = oRng.Parent.Shapes.AddPicture(sURL, True, True, vLeft, vTop, PictureSize, PictureSize)
oPic.Name = PictureName
URL_QRCode_SERIES = DisplayText
End Function
