Générateur de QR code - Indicatif de numéro de tel

**maximus172** · 30/12/2022, 11h54

Bonjour

J'ai récupéré une macro permettant de générer des QR CODE VCARD. Celle ci fonctionne très bien si ce n'est les numéros de téléphone.
Elle est associé avec un fichier exel dont l'onglet se nomme "Contact_Info"

Je cherche le moyen d'y inclure le "+" ou "+33" dans le numéro de téléphone. J'ai changé le format de cellule excel mais cela ne vient pas de la.
Je pense qu'il faut chercher du coté du "TYPE" ou je dois adapter qqch. Je lis sur internet des Value=URI mais je ne vois pas comment faire.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
 
Sub generateQRCode()
 
Dim sPict As Object
 
SupprimerQR
 
strURL = "http://chart.googleapis.com/chart?cht=qr"
 
 
For intRow = 2 To 75
strFname = Trim(ThisWorkbook.Sheets("Contact_Info").Range("A" & intRow).Text)           'prénom
strLname = Trim(ThisWorkbook.Sheets("Contact_Info").Range("B" & intRow).Text)           'nom
strCellPhone = Trim(ThisWorkbook.Sheets("Contact_Info").Range("C" & intRow).Text)       'tel mobile
strBusinessPhone = Trim(ThisWorkbook.Sheets("Contact_Info").Range("D" & intRow).Text)   'tel fixe
strCompn = Trim(ThisWorkbook.Sheets("Contact_Info").Range("E" & intRow).Text)           'Adresse compagnie
stretat = Trim(ThisWorkbook.Sheets("Contact_Info").Range("F" & intRow).Text)            'Etat
strcodepostal = Trim(ThisWorkbook.Sheets("Contact_Info").Range("G" & intRow).Text)      'code postal
strville = Trim(ThisWorkbook.Sheets("Contact_Info").Range("H" & intRow).Text)           'Ville
strpays = Trim(ThisWorkbook.Sheets("Contact_Info").Range("I" & intRow).Text)            'Pays
strDept = Trim(ThisWorkbook.Sheets("Contact_Info").Range("J" & intRow).Text)            'Département
strEmail = Trim(ThisWorkbook.Sheets("Contact_Info").Range("L" & intRow).Text)           'email
strJobTitle = Trim(ThisWorkbook.Sheets("Contact_Info").Range("K" & intRow).Text)        'Titre
 
strVCF = ""
strVCF = strVCF & "BEGIN:VCARD" & Chr(10)
strVCF = strVCF & "VERSION:3.0" & Chr(10)
 
strVCF = strVCF & "N:" & strLname & ";" & strFname & Chr(10)
strVCF = strVCF & "FN:" & strFname & " " & strLname & Chr(10)
strVCF = strVCF & "ORG:Société XX" & Chr(10)
strVCF = strVCF & "TITLE:" & strJobTitle & " | " & strDept & Chr(10)
 
strVCF = strVCF & "TEL;TYPE=CELL:" & strCellPhone & Chr(10)
strVCF = strVCF & "TEL;TYPE=WORK;TYPE=PREF:" & strBusinessPhone & Chr(10)
strVCF = strVCF & "EMAIL:" & strEmail & Chr(10)
 
strVCF = strVCF & "URL:http://www.test.com" & Chr(10)
 
strVCF = strVCF & "ADR;TYPE=WORK:;;" & strCompn & ";" & strville & ";" & stretat & ";" & strcodepostal & ";" & strpays & Chr(10)
 
strVCF = strVCF & "END:VCARD"
 
ThisWorkbook.Sheets("Contact_Info").Range("M" & intRow) = strVCF
 
strChs = "&chs=174" & "x" & "174"
strChl = "&chl="
strFinalURL = strURL & strChs & strChl & strVCF
 
Dim pic As Object, sh As shape
ActiveSheet.Range("M" & intRow).Select
 
Set sPict = ActiveSheet.Pictures.Insert(strFinalURL)
sPict.Top = ActiveSheet.Range("N" & intRow).Top
sPict.Left = ActiveSheet.Range("N" & intRow).Left
Next
 
 
End Sub
 
Sub SupprimerQR()
 
   Dim shape As Excel.shape
   For Each shape In ActiveSheet.Shapes
         shape.Delete
   Next
   End Sub

Si vous avez la solution, je suis preneur.

Merci et bonne année

**deedolith** · 30/12/2022, 13h48

Salut,

A mon avis, c'est un problème de conversion implicite.
Excel convertis automatiquement le N° de téléphone en nombre, alors que c'est du texte. en conséquence le signe + passe à la trappe.
Pour forcer le type de donnée en texte, il faut ajouter une apostrophe en début de saisie (Saisir '+33, et non +33).

Maintenant concernant ton code:
Ta fonction viole le SRP (https://en.wikipedia.org/wiki/Single...lity_principle), divise la en plusieurs sous-fonctions, ce sera plus facile à maintenir.
Abandonne la notation hongroise, ca ne fait que polluer ton source.
Une structure ou classe représentant une personne aurait été la bienvenue.

**Philippe Tulliez** · 30/12/2022, 14h20

Bonjour,
Avez-vous été voir sur cette page Wikipedia - vCard

@deedolith

Pour forcer le type de donnée en texte, il faut ajouter une apostrophe en début de saisie (Saisir '+33, et non +33).

C'est la première chose évidemment à laquelle j'ai pensé mais cela ne change rien, j'ai aussi utilisé le format personnalisé ainsi que la concaténation dans le code lui même et dans la cellule et c'est toujours pareil

Il faut chercher ailleurs mais je n'ai pas le temps de poursuivre

**deedolith** · 30/12/2022, 14h53

Sauf erreur de ma part, le + à une signification particulière dans l'encodage d'une URL.
Ne faudrait il pas l'échapper ?

Voir cet article:
https://www.w3schools.com/tags/ref_urlencode.ASP

**Philippe Tulliez** · 30/12/2022, 15h08

Bonjour deedolith,

Sauf erreur de ma part, le + à une signification particulière dans l'encodage d'une URL.
Ne faudrait il pas l'échapper ?

Bien vu

En concaténant %2B dans la ligne strvcf = strvcf & "TEL;TYPE=cell:" & "%2B" & strcellphone & Chr(10) on a bien le signe +

Il faudrait bien entendu améliorer ce code en utilisant la fonction REPLACE pour l'ensemble des caractères proscrits en HTML

**Thumb down** · 30/12/2022, 19h51

Bonsoir,
si tu veux générer un QrCode correcte il faut gérer tous les caractères spéciaux dans l'URL!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
Private Function AssainirURL(MonURL As String) As String
'par Excel-Malin.com ( https://excel-malin.com )
Dim URLtemporaire As String
 
 
URLtemporaire = MonURL
URLtemporaire = Replace(URLtemporaire, "%", "%25", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, Chr(10), "%0A", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, Chr(13), "%0D", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, ":", "%3A", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, " ", "%20", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, """", "%22", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "#", "%23", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "$", "%24", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "&", "%26", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "'", "%27", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "(", "%28", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "°", "%C2%B0", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, ")", "%29", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "*", "%2A", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "+", "%2B", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, ",", "%2C", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, ";", "%3B", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "<", "%3C", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "=", "%3D", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, ">", "%3E", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "?", "%3F", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "@", "%40", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "[", "%5B", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "]", "%5D", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "^", "%5E", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "`", "%60", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "{", "%7B", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "|", "%7C", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "}", "%7D", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "~", "%7E", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "¢", "%C2%A2", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "£", "%C2%A3", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "¥", "%C2%A5", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "|", "%A6", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "§", "%C2%A7", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "«", "%C2%AB", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "¬", "%C2%AC", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "¯", "%C2%AF", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "º", "%C2%BA", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "±", "%C2%B1", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "ª", "%C2%AA", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, ",", "%B4", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "µ", "%C2%B5", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "»", "%C2%BB", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "¼", "%C2%BC", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "½", "%C2%BD", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "¿", "%C2%BF", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "À", "%C3%80", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Á", "%C3%81", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Â", "%C3%82", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Ã", "%C3%83", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Ä", "%C3%84", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Å", "%C3%85", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Æ", "%C3%86", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Ç", "%C3%87", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "È", "%C3%88", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "É", "%C3%89", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Ê", "%C3%8A", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Ë", "%C3%8B", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Ì", "%C3%8C", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Í", "%C3%8D", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Î", "%C3%8E", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Ï", "%C3%8F", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Ð", "%C3%90", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Ñ", "%C3%91", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Ò", "%C3%92", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Ó", "%C3%93", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Ô", "%C3%94", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Õ", "%C3%95", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Ö", "%C3%96", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Ø", "%C3%98", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Ù", "%C3%99", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Ú", "%C3%9A", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Û", "%C3%9B", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Ü", "%C3%9C", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Ý", "%C3%9D", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "Þ", "%C3%9E", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "ß", "%C3%9F", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "à", "%C3%A0", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "á", "%C3%A1", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "â", "%C3%A2", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "ã", "%C3%A3", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "ä", "%C3%A4", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "å", "%C3%A5", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "æ", "%C3%A6", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "ç", "%C3%A7", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "è", "%C3%A8", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "é", "%C3%A9", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "ê", "%C3%AA", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "ë", "%C3%AB", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "ì", "%C3%AC", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "í", "%C3%AD", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "î", "%C3%AE", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "ï", "%C3%AF", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "ð", "%C3%B0", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "ñ", "%C3%B1", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "ò", "%C3%B2", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "ó", "%C3%B3", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "ô", "%C3%B4", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "õ", "%C3%B5", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "ö", "%C3%B6", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "÷", "%C3%B7", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "ø", "%C3%B8", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "ù", "%C3%B9", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "ú", "%C3%BA", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "û", "%C3%BB", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "ü", "%C3%BC", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "ý", "%C3%BD", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "þ", "%C3%BE", compare:=vbBinaryCompare)
URLtemporaire = Replace(URLtemporaire, "ÿ", "%C3%BF", compare:=vbBinaryCompare)
 
 
AssainirURL = URLtemporaire
Exit Function
 
 
FonctionErreur:
AssainirURL = CVErr(xlErrValue)
 
 
End Function