QR CODE trong Excell

[xuanchientn]

Các pro giúp em quy định mã QR code theo thứ tự B1,B2 theo tên bên cột A với,giờ e tạo ra nó chồng lên nhau.thank all

 

[HUONGHCKT]

Không biết đúng ý bạn chưa?
Thay đoạn Active cells bằng địa chỉ ô cần trả về mã QR

 

[giaiphap]

Các pro giúp em quy định mã QR code theo thứ tự B1,B2 theo tên bên cột A với,giờ e tạo ra nó chồng lên nhau.thank all

Do bạn không nói rõ nên làm theo tôi hiểu, có gì chưa đúng thì nói để tính tiếp.

Private Function pic_QR(ByVal QR_Value As String, ByVal Target As Range, Optional ByVal Size As Long = 150) As Shape
Dim sURL As String
On Error Resume Next
    If Len(QR_Value) Then
        sURL = "https://chart.googleapis.com/chart?chs=" & Size & "x" & Size & "&cht=qr&chl="
        sURL = sURL & QR_Value
        Set pic_QR = Target.Parent.Shapes.AddPicture(sURL, True, True, Target.Left, Target.Top, 30, 30)
    End If
End Function
Sub delShp(s As String)
    On Error Resume Next
    Dim Shp As Shape
    Sheet8.Shapes(s).Delete
End Sub
Sub Main()
Dim Shp As Shape
    Call delShp(Cells(ActiveCell.Row, 1).Address(0, 0))
    Set Shp = pic_QR(Cells(ActiveCell.Row, 1).Value, ActiveCell)
    Shp.Name = Cells(ActiveCell.Row, 1).Address(0, 0)
End Sub

 

[xuanchientn]

Không biết đúng ý bạn chưa?
Thay đoạn Active cells bằng địa chỉ ô cần trả về mã QR

Thanks Pro nhé đúng ý em rồi ạ.

 

[xuanchientn]

Do bạn không nói rõ nên làm theo tôi hiểu, có gì chưa đúng thì nói để tính tiếp.

Private Function pic_QR(ByVal QR_Value As String, ByVal Target As Range, Optional ByVal Size As Long = 150) As Shape
Dim sURL As String
On Error Resume Next
    If Len(QR_Value) Then
        sURL = "https://chart.googleapis.com/chart?chs=" & Size & "x" & Size & "&cht=qr&chl="
        sURL = sURL & QR_Value
        Set pic_QR = Target.Parent.Shapes.AddPicture(sURL, True, True, Target.Left, Target.Top, 30, 30)
    End If
End Function
Sub delShp(s As String)
    On Error Resume Next
    Dim Shp As Shape
    Sheet8.Shapes(s).Delete
End Sub
Sub Main()
Dim Shp As Shape
    Call delShp(Cells(ActiveCell.Row, 1).Address(0, 0))
    Set Shp = pic_QR(Cells(ActiveCell.Row, 1).Value, ActiveCell)
    Shp.Name = Cells(ActiveCell.Row, 1).Address(0, 0)
End Sub

thanks pro nhé bác HUONGHCKT viết ok rồi nhé