Export vCard avec champ NOTE plusieurs lignes

Bonjour,

Je voudrais exporter mon contact au format vcard mon fichier excel fonctionne même si le code n'est pas terrible.

Cependant je dois exporter ma ligne 5 col 22 (Notes) c'est un contact exemple

Le code devra modifier dans un variable sans modifier la cellule.

l'exemple en cellule ligne 4 col 22 correspond au texte de la variable

donc ajouter \n en bout de chaque ligne en respectant un maximum de 65 caracteres (entre chaque \n) avec espace compris et assembler le tout sur une seule ligne.

text exemple :

L'association des deux a une histoire logique : le retour chariot

sans saut de ligne permettant de revenir en début de ligne pour 7

se contentait de passer à la ligne suivante sans déplacer le chariot ; d'où la nécessité

travail en binôme préventif la nuit curatif en journée

fin du texte

devient dans la variable :

L'association des deux a une histoire logique : le retour chariot\net sans saut de ligne permettant de revenir en début de ligne pour 7\se contentait de passer à la ligne suivante sans déplacer le chariot ; d'où la nécessité\ntravail en binôme préventif la nuit curatif en journée\nfin du texte

si quelqu'un à une idée

Merci Jean

Re-

fais un essai avec ceci

        & "NOTE:" & transformer(F1.Range("V" & i).Value) & vbCrLf _

Function transformer(texte As String) As String
Dim i As Integer
    transformer = Replace(texte, Chr(10), "\n")
    i = 1
    Do
        If i Mod 65 = 0 Then transformer = Left(transformer, i) & vbCrLf & " " & Mid(transformer, i + 1)
        i = i + 1
    Loop While i < Len(transformer)
    transformer = transformer & "*"
End Function

Correctif pour 1ère ligne ...

        & transformer("NOTE:" & F1.Range("V" & i).Value) & vbCrLf _

Function transformer(texte As String) As String
Dim i As Integer, nbcar As Integer
nbcar = 65
    transformer = Replace(texte, Chr(10), "\n")
    i = nbcar - 2: nbcar = nbcar + 2 ' correctif de 2 première ligne !
    Do
        If (i + 2) Mod nbcar = 0 Then transformer = Left(transformer, i) & vbCrLf & " " & Mid(transformer, i + 1)
        i = i + 1
    Loop While i < Len(transformer)
    transformer = transformer & "*"
End Function

bonjour

merci Steelson.

Je vais essayer si j'ai un peu de temps aujourd'hui

Bonjour,

Function transformer(texte As String) As String
Dim i As Integer, nbcar As Integer
nbcar = 75
    'transformer = Replace(texte, Chr(10), "\n")
        transformer = Replace(texte, vbCrLf, "\n")
    i = nbcar - 2: nbcar = nbcar + 2 ' correctif de 2 première ligne !
    Do
        If (i + 2) Mod nbcar = 0 Then transformer = Left(transformer, i) & vbCrLf & " " & Mid(transformer, i + 1)
        i = i + 1
    Loop While i < Len(transformer)
    transformer = transformer & ""
End Function

j'ai mis vbCrLf à la place de Chr(10) et ça fonctionne.

Autrement pour les numero de tel comme les cellules sont formatés en catégorie spéciale et numero de tel on perd le 0 du 06.

dans la barre de formule aussi quand on selectionne une cellule.

Parfait !

Bonjour,

Juste une remarque pour Jean35 : ça aurait été plus correct d'indiquer la source du code principal dont est issu cet export de vcard

=> http://tatiak.canalblog.com/archives/2015/06/22/32254245.html

Pierre

PS : Salut Steelson

Je me disais bien, j'étais justement en train de fouiller dans mes précieuses archives ...

http://tatiak.canalblog.com/archives/2015/06/22/32254245.html

J'aurais donc eu le plaisir (et l'humble honneur) de contribuer à cet outil pour du "multi-lignes" de NOTES !!

J'ai en plus découvert un module génial utf-8 !

c'est vrai tu as raison source : http://tatiak.canalblog.com/archives/2015/06/22/32254245.html

Cordialement.

pour le N° de tel

J'ai mis :

                    Case S1(0) Like "TEL*"

                        If S1(0) Like "*W*;*V*" Then ajouter 12, S1(1)  'Tel_fix_Pro
                        If S1(0) Like "*WORK*" Then ajouter 12, S1(1)   'Tel_fix_Pro
                        If S1(0) Like "*WORK;V*" Then ajouter 10, S1(1) 'Tel_fix_Pro
                        If S1(0) Like "*OTHER*" Then ajouter 13, S1(1)  'Tel_Autre
                        If S1(0) Like "*M2*" Then ajouter 13, S1(1) 'Tel_Autre
                        If S1(0) Like "*CEL*" Then ajouter 14, S1(1)    'Tel_Mobil
                        If S1(0) Like "*FAX*" Then ajouter 15, S1(1)    'Fax

                        Format ("0#"" ""##"" ""##"" ""##"" ""##") 'formate en N° Tel