XL 2019 QR code pour Vcard

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
A

australopitheque

XLDnaute Nouveau
bonjour a tous
j'ai en piochant a gauche et a droite des idées pour mon projet.
j'explique je voulait a partir de donnée perso (nom , prénom ,adresse etc etc) crée un qrcode pour y faire ma carte de visite avec du contenue vcard dans le qrcode.
mais j'ai du mal avec la mise en page de ma carte de visite (mettre en gras certaine partie, voir colorisation et l'ajout d'un logo sur la carte en arrière plan style filigrane.
je voulait avoir votre avis et conseil.
 

Pièces jointes

Trier par date Trier par votes
Bonjour Australopitheque et bienvenue sur ce forum 😉

Joli petite trouvaille ton générateur de QRcode au format vcard 👍

Pour le texte, tu seras obligé de passer par du code VBA, pas d'autre choix
Voici un code explicatif de ce qu'on peut faire, à adapter à tes besoins
VB: 
Sub FormatPartieCellule()
Dim motdebut As String, montant As String, motfin As String, compte As String, a As String, b As String, c As String, d As String

motdebut = "Merci de verser la somme de : "
montant = Format(Range("B3"), "#,##0.00 €")
motfin = "  sur le compte bancaire "
compte = "000-1234567-89"

'on écrit la phrase en D17
Range("D17") = motdebut & montant & motfin & compte

' on compte le nombre de caractères
a = Len(motdebut)
b = Len(montant)
c = Len(compte)
d = Len(Range("D17"))

' on met le montant dans les formats désirés (à partir de a, le nombre de caractères de b)
With Range("D17").Characters(Start:=a, Length:=b + 1).Font
    .Bold = True 'gras
    .ColorIndex = 3 'rouge
    .Italic = True 'italique
    .Underline = xlUnderlineStyleSingle 'souligné
End With

'on met le compte en gras
Range("D17").Characters(Start:=d - c + 1, Length:=c).Font.Bold = True

End Sub

@+
 
Vote positif 0 Vote négatif
merci pour ton aide j'ai fait une mise en form vb comme tu me l'a conseillé.
et crée une zone de texte de mise en forme qui ce reproduit dans ma fenêtre de carte de visite.
dés modification des données tout ce mets en forme, texte et qr code.
VB: 
Dim noEvents As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tmp, ch As String, i As Long, j As Long
    If noEvents Then Exit Sub
    If Not Intersect(Target, [B11:B33]) Is Nothing Then
        tmp = [C11:C33].Value
        For i = 1 To 23
            ch = ch & " " & tmp(i, 1)
        Next i
        noEvents = True
        [D2].Value = Mid(ch, 2)
        i = 1
        For j = 0 To 22
            With [D2].Characters(i, Len(tmp(j + 1, 1)) + 1).Font
                .Color = [c11].Offset(j).Font.Color
                .Bold = [c11].Offset(j).Font.Bold
                .Italic = [c11].Offset(j).Font.Italic
            End With
            i = i + Len(tmp(j + 1, 1)) + 1
        Next j
        noEvents = False
    End If
End Sub
 

Pièces jointes

Vote positif 0 Vote négatif
bonjour
par contre comment faire répéter la zone d'impression sur la même feuille ?
j'ai fait un bouton avec macro simple d'apercu et après d'impression si on choisie de le faire.
mais je voit pas du tout comment faire pour faire une mosaique de l'impressions sur la même feuille.(faire plusieur carte sur la même impression)
VB: 
Sub imprimer_apercu()
'
' imprimer_apercu Macro
'
Application.Dialogs(xlDialogPrintPreview).Show
'
End Sub
 
Vote positif 0 Vote négatif
australopitheque à dit:
merci pour ton aide j'ai fait une mise en form vb comme tu me l'a conseillé.
et crée une zone de texte de mise en forme qui ce reproduit dans ma fenêtre de carte de visite.
dés modification des données tout ce mets en forme, texte et qr code.
VB: 
Dim noEvents As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tmp, ch As String, i As Long, j As Long
    If noEvents Then Exit Sub
    If Not Intersect(Target, [B11:B33]) Is Nothing Then
        tmp = [C11:C33].Value
        For i = 1 To 23
            ch = ch & " " & tmp(i, 1)
        Next i
        noEvents = True
        [D2].Value = Mid(ch, 2)
        i = 1
        For j = 0 To 22
            With [D2].Characters(i, Len(tmp(j + 1, 1)) + 1).Font
                .Color = [c11].Offset(j).Font.Color
                .Bold = [c11].Offset(j).Font.Bold
                .Italic = [c11].Offset(j).Font.Italic
            End With
            i = i + Len(tmp(j + 1, 1)) + 1
        Next j
        noEvents = False
    End If
End Sub
Cliquez pour agrandir...
Dans cette version ton QrCode ne fonctionne pas!
tu retraite pas le format de ton url!


Voila un exemple


VB: 
Private Function AssainirURL(MonURL As String) As String
On Error GoTo FonctionErreur

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(xlValue)

End Function
 
Dernière édition:
Vote positif 0 Vote négatif
bonjour
tu parle de l'adresse web ?
oui celle là je l'avais oublié en traitement mais est facile a modifié.
voilà corrigé avec mon bouton aperçu avant impression.
me manque plus que la mosaïque ou multiple car une carte par feuille ça va couter chère en feuille ^^,mais je voit pas comment faire.
 

Pièces jointes

Vote positif 0 Vote négatif
Bonjour australopitheque

Je ne comprends pas ton monologue, tu parles tout seul ou tu t'es trompé de forum 🤔

Edit : arf non il me manque le post #5 (peut-être un membre ignoré 😜 punaise au moins c'est efficace 🤣 )

A+
 
Dernière modification par un modérateur:
Vote positif 0 Vote négatif
bon je me répond a moi même 😀
la seul solution que j'ai trouver, mais qui me parait lourd est une copie multiple sur une autre page et de copier en image lié plusieurs fois et d'avoir un autre bouton impression supplémentaire.
toutes ces images ce mettent a jours mais alourdissent l'ensemble je trouve.
peut etre un vb qui reproduirait ça en mémoire au moment de faire l'impression??
 
Vote positif 0 Vote négatif
je te remercie au moins ca me dit que j'ai la bonne réflexion et prit la bonne direction.
reste plus cas trouver comment faire en vb, mais ce soir je cale ^^.
je me pencherai dessus plus tard ou du moins si tu as un exemple ,ça m'arrangerai, car je voit pas comment le prendre. 😉
peut être partir de ce code que je vient de trouver.
VB: 
Sub Pics()
Dim f1 As Worksheet, f2 As Worksheet
Application.ScreenUpdating = False

Set f1 = Sheets("Feuil1")
Set f2 = Sheets("Feuil2")

'Défnition de la zone à copier
f1.Range("C3:I10").Copy
'Collage de la photo
With f2
    .Range("E1").Select
    .Pictures.Paste.Name = "Pics1"
    Application.CutCopyMode = False
End With

With ThisWorkbook
    .Names.Add Name:="PicsOn", RefersTo:="=1"
    .Names.Add Name:="Pics1", RefersToR1C1:= _
        "=IF(PicsOn=1,Feuil1!R3C3:R10C9,"""")"
End With
    f2.Shapes.Range(Array("Pics1")).Select
    Selection.Formula = "=Pics1"
End Sub
Sub TurnOffPictures()
    ThisWorkbook.Names("PicsOn").RefersTo = "0"
End Sub
Sub TurnOnPictures()
    ThisWorkbook.Names("PicsOn").RefersTo = "1"
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
bon j'ai fait ça mais j'ai un soucis pour mettre ça en boucle pour répétition
il me fait la copie dans ma page d'impression (mais pas le filigrane)mais je cherche a comment mettre une boucle pour qu'il me fasse plusieurs copie en dessous.
ça doit être simple mais .....je butte et je doit faire une erreur quelque part j'ai l'impression..

VB: 
Sub Pics()
Dim f1 As Worksheet, f2 As Worksheet
Application.ScreenUpdating = False
Set f1 = Sheets("QR code vcard")
Set f2 = Sheets("impresion multiple")


    f1.Range("d2:e2").Copy
    With f2
   
    f2.Range("A2").PasteSpecial xlPasteColumnWidths
    f2.Range("A2").PasteSpecial xlPasteAllUsingSourceTheme
    Application.CutCopyMode = False
    End With
    f2.Range("b2").Value = ""
    Set f1 = Nothing
    Set f2 = Nothing
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
bonjour, re déterrage du post j'ai un très petit soucis de mise en forme dans la copie.
en gros dans la cellule faite pour téléphone, j'y est mis la forme spécial téléphonique,
car je perdait le premier zéro.
mais lors de la copie il perd cette mise en forme dans la zone préparer pour copie multiple.
je pense que l'erreur est dans cette macro.
VB: 
Dim noEvents As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tmp, ch As String, i As Long, j As Long
    If noEvents Then Exit Sub
    If Not Intersect(Target, [B11:B33]) Is Nothing Then
        tmp = [C11:C33].Value
        For i = 1 To 23
            ch = ch & " " & tmp(i, 1)
        Next i
        noEvents = True
        [D2].Value = Mid(ch, 2)
        i = 1
        For j = 0 To 22
            With [D2].Characters(i, Len(tmp(j + 1, 1)) + 1).Font
                .Color = [c11].Offset(j).Font.Color
                .Bold = [c11].Offset(j).Font.Bold
                .Italic = [c11].Offset(j).Font.Italic
            End With
            i = i + Len(tmp(j + 1, 1)) + 1
        Next j
        noEvents = False
    End If
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

T
  • Question Question
XL 2010 Générer QR Code de Vcard en masse
Réponses
0
Affichages
2 K
Tony74
T
Retour