Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2019 QR code pour Vcard

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

  • Classeur1.xlsm
    22.5 KB · Affichages: 37
Trier par date Trier par votes
C

Compte Supprimé 979

Guest
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
A

australopitheque

XLDnaute Nouveau
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

  • Classeur1.xlsm
    26.4 KB · Affichages: 22
Vote positif 0 Vote négatif
A

australopitheque

XLDnaute Nouveau
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

dysorthographie

XLDnaute Accro
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
A

australopitheque

XLDnaute Nouveau
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

  • Classeur1.xlsm
    34.1 KB · Affichages: 7
Vote positif 0 Vote négatif
C

Compte Supprimé 979

Guest
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
A

australopitheque

XLDnaute Nouveau
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
C

Compte Supprimé 979

Guest
Re,

Edit : j'avais bien compris, et effectivement la seule solution c'est avec une page dédiée un copie / collage spécial image liée

Je n'ai mis que 2 images sinon ça devient trop volumineux

Ca peut-être fait en VBA bien sur

Bonne soirée
 

Pièces jointes

  • Générateur QRCode de Vcard 3.xlsm
    870.1 KB · Affichages: 32
Vote positif 0 Vote négatif
A

australopitheque

XLDnaute Nouveau
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
A

australopitheque

XLDnaute Nouveau
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
A

australopitheque

XLDnaute Nouveau
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
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

T
  • Question
XL 2010 Générer QR Code de Vcard en masse
Réponses
0
Affichages
2 K
Tony74
T
M
[REF] Wiki Page 8 de MichelXld
Réponses
0
Affichages
38 K
MichelXld
M
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…