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