Petite question (en bonus 
), sur ma feuille Page Type je fais en sorte que lorsqu’on introduit une adresse web, le code du module vba me génère un QR code dans ma feuille ETIQUETTE, en bas à droite de l’etiquette, voici le code que j’ai placé dans le module:
Option Explicit
Function URL_QRCode_SERIES( _
ByVal QR_Value As String, _
Optional ByVal PictureSize As Long = 100, _
Optional ByVal DisplayText As String = « », _
Optional ByVal Updateable As Boolean = True) As Variant
Dim PictureName As String
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 = « cht=qr »
Const sDataParameter As String = « chl= »
Const sJoinCHR As String = « & »
If Updateable = False Then
URL_QRCode_SERIES = « outdated »
Exit Function
End If
PictureName = « QRCode » & Application.Caller.Address
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)
oPic.Delete
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 & UTF8_URL_Encode(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
Function UTF8_URL_Encode(ByVal sStr As String)
Dim i As Long
Dim a As Long
Dim res As String
Dim code As String
res = ""
For i = 1 To Len(sStr)
a = AscW(Mid(sStr, i, 1))
If a < 128 Then
code = Mid(sStr, i, 1)
ElseIf ((a > 127) And (a < 2048)) Then
code = URLEncodeByte(((a \ 64) Or 192))
code = code & URLEncodeByte(((a And 63) Or 128))
Else
code = URLEncodeByte(((a \ 144) Or 234))
code = code & URLEncodeByte((((a \ 64) And 63) Or 128))
code = code & URLEncodeByte(((a And 63) Or 128))
End If
res = res & code
Next i
UTF8_URL_Encode = res
End Function
Private Function URLEncodeByte(val As Integer) As String
Dim res As String
res = "%" & Right("0" & Hex(val), 2)
URLEncodeByte = res
End Function
Le problème est que si je met le lien de youtube, ou apple ou autre , ça fonctionne mais des que je met une adresse style une adresse se terminant par .pdf, le qr code est blanc, il ne s’affiche pas ??
Comprenez vous pourquoi ?
