Private Sub Worksheet_Change(ByVal Target As Range)
Dim BarcodeLink As String, BarcodePath As String, saveInFolder As String
Application.ScreenUpdating = False
If Not Intersect(Target, Range("D17")) Is Nothing Then
If Range("D17").Value <> "" Then
Call QRCodeToCell(Range("D17"), Range("F17"), 130, 130)
End If
End If
End Sub
'----------------------------
'Génère un QR code en cellule
'
'Arguments:
'---------
'- Chaine : Chaine à encoder en QR Code
'- Cellule : Cellule où placer l'image du QR Code
'- PicWidth : Largeur de l'image du QR Code
'- PicHeight: Hauteur de l'image du QR Code
'
'- Return : Objet Picture de l'image du QR Code
'----------------------------
Function QRCodeToCell(Chaine As String, _
Cellule As Range, _
Optional PicWidth As Integer = 120, _
Optional PicHeight As Integer = 120) As Picture
Dim Link As String
Dim Pic As Picture
Dim PicName As String
'https://developers.google.com/chart/infographics/docs/qr_codes
Link = "http://chart.googleapis.com/chart?cht=qr&chs=" & PicWidth & "x" & PicHeight & "&chl=" & Chaine
Windows(Cellule.Parent.Parent.Name).Activate
Cellule.Parent.Activate
Cellule.Activate
PicName = "QRCode_" & Cellule.Address(0, 0)
'Supprime une Shape de ce nom éventuellement présente
For Each Pic In ActiveSheet.Pictures
If Pic.Name = PicName Then Pic.Delete
Next Pic
'Génère l'image QR Code
Set Pic = ActiveSheet.Pictures.Insert(Link)
With Pic
.Top = Cells(17, 6).Top - 15 '=====>> A' ADAPTER
.Left = Cells(17, 6).Left + 70 '=====>> A' ADAPTER
.Name = PicName
End With
' Pic.Name = PicName
Set QRCodeToCell = Pic
End Function
).
