Sujet Précédent Sujet Suivant

Garder style d'écriture dans Macro

Résolu/Fermé
gunbafo Messages postés 55 Date d'inscription jeudi 16 juillet 2009 Statut Membre Dernière intervention 18 février 2011 - 26 janv. 2011 à 14:36
gunbafo Messages postés 55 Date d'inscription jeudi 16 juillet 2009 Statut Membre Dernière intervention 18 février 2011 - 18 févr. 2011 à 15:38
Bonjour,

J'ai le code ci-dessous qui me sers à copier des informations d'une feuille Excel (Base de données) à un autre (Mail) de façon à ce qu'elles soient Mise en forme différemment (ex: plusieurs cellules regroupées en une) pour ensuite correspondre à un format email.
Ce que je voudrais c'est de garder le style d'écriture italique (par exemple: Gras, Italique, Souligné) de certains mots des cellules de la colonne P de la feuille "Base de données" aux cellules de la colonne L de la feuille "Mail".

Voici le code:

Private Sub Image4_Click()

Dim DernLign As Integer, Lign As Integer

With Sheets("Mail").Select
Range("B3:N3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
End With

With Sheets("Base de données")
DernLign = .Cells(65536, 3).End(xlUp).Row
For Lign = 3 To DernLign
Sheets("Mail").Cells(Lign, 2) = .Cells(Lign, 2) & vbLf & .Cells(Lign, 3) & vbLf & .Cells(Lign, 5) & vbLf & .Cells(Lign, 6)
Sheets("Mail").Cells(Lign, 3) = .Cells(Lign, 1) & vbLf & .Cells(Lign, 4) & vbLf & .Cells(Lign, 7)
Sheets("Mail").Cells(Lign, 4) = .Cells(Lign, 8)
Sheets("Mail").Cells(Lign, 5) = .Cells(Lign, 9)
Sheets("Mail").Cells(Lign, 6) = .Cells(Lign, 10)
Sheets("Mail").Cells(Lign, 7) = .Cells(Lign, 11)
Sheets("Mail").Cells(Lign, 8) = .Cells(Lign, 12)
Sheets("Mail").Cells(Lign, 9) = .Cells(Lign, 13)
Sheets("Mail").Cells(Lign, 10) = .Cells(Lign, 14)
Sheets("Mail").Cells(Lign, 11) = .Cells(Lign, 15)
Sheets("Mail").Cells(Lign, 12) = .Cells(Lign, 16)
Sheets("Mail").Cells(Lign, 13) = .Cells(Lign, 17)
Sheets("Mail").Cells(Lign, 14) = .Cells(Lign, 18)
Next Lign
End With


Merci pour votre aide
A voir également:

8 réponses

Réponse 1 / 8
lermite222 Messages postés 8724 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
26 janv. 2011 à 15:10
Bonjour,
Pas tester mais ça devrait aller... 
    With Sheets("Base de données")
        DernLign = .Cells(65536, 3).End(xlUp).Row
        For Lign = 3 To DernLign
        Sheets("Mail").Cells(Lign, 2) = .Cells(Lign, 2) & vbLf & .Cells(Lign, 3) & vbLf & .Cells(Lign, 5) & vbLf & .Cells(Lign, 6)
        .Cells(Lign, 3).Copy
        Sheets("Mail").Cells(Lign, 2).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        Sheets("Mail").Cells(Lign, 3) = .Cells(Lign, 1) & vbLf & .Cells(Lign, 4) & vbLf & .Cells(Lign, 7)
        .Cells(Lign, 1).Copy
        Sheets("Mail").Cells(Lign, 3).PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        Sheets("Mail").Range(Cells(Lign, 4), Cells(Lign, 14)).Copy .Cells(Lign, 8)
        Next Lign
    End With

A+
0
gunbafo Messages postés 55 Date d'inscription jeudi 16 juillet 2009 Statut Membre Dernière intervention 18 février 2011 3
26 janv. 2011 à 15:54
Salut lermite222,

désolé de te décevoir mais ça ne fonctionne pas.
Tu m'as écris le code pour les mauvaise colonnes,
c'est cette ligne de code qui m'interresse: Sheets("Mail").Cells(Lign, 12) = .Cells(Lign, 16)

l'autre souci c'est que ça ne transpose pas seulement les mots en Gras de la "Base de données" au "Mail". Tout les mots deviennent Gras!

Saurais tu comment y remédier?

Merci
0
Réponse 2 / 8
lermite222 Messages postés 8724 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
26 janv. 2011 à 16:10
Je pense que oui, mais pour ne pas tourner en rond tu devrais mettre un classeur exemple avec une feuille Base et sur une autre feuille le résultat souhaiter.
Tu peu déposer ton classeur sur CiJoint.fr
et mettre le lien sur un poste suivant.
0
gunbafo Messages postés 55 Date d'inscription jeudi 16 juillet 2009 Statut Membre Dernière intervention 18 février 2011 3
26 janv. 2011 à 16:44
voir le post:

https://forums.commentcamarche.net/forum/affich-20659215-fermeture-userform-vba#p20661133
0
Réponse 3 / 8
lermite222 Messages postés 8724 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
2 févr. 2011 à 13:04
Je veux bien voir pour t'aider mais le classeur que tu a déposer ne comporte rien qui puisse m'aiguiller.
1°) Les feuilles mentionnées sur le code ci-dessus n'existe pas.
2°) Aucune données à recopier
3°) Aucune donnée recopiée.
Mettre un classeur avec
- une feuille Base de donnée comportant des données (avec mise en forme)
- Une feuille Mail avec les données recopiées et la mise en forme qu'elles doivent avoir ou garder.
Sans ça.. pas moyen de t'aider.
A+
0
Réponse 4 / 8
gunbafo Messages postés 55 Date d'inscription jeudi 16 juillet 2009 Statut Membre Dernière intervention 18 février 2011 3
3 févr. 2011 à 12:00
Salut lermite,

J'avais fais le ménage dans les cellules et changer les noms des feuilles pour garder une certaine confidentialité.
Pour équivalence, les feuilles:
- "Base de donnée" du code ci-dessus sont "Point Ordo-Montage"(FKG1 & FKG2 & PKG) du classeur que j'ai déposé
- "Mail" du code ci-dessus sont "Mail" (FKG1 & FKG2 & PKG) du classeur que j'ai déposé

Pour les données à recopier, il s'agit des cellules de la colonne "Commentaires" des 3 Feuille "Point Ordo Montage"FKG1, FKG2 et PKG qui doivent être recopier dans les 3 feuilles "Mail" respective FKG1, FKG2 et PKG avec le style d'écriture. Actuellement le copier/coller marche grâce au boutons MAIL dans le UF Menu sans garder ce style d'écriture.
Dans le VBA, le code se trouve dans le UF Menu, procédure commencant par "Private Sub Image4_Click()"

voici le fichier avec 2 pbls dans chaque feuille (Point Ordo-Montage):
http://www.cijoint.fr/cjlink.php?file=cj201102/cijlKg3cAu.xls

Fais la manip avec le bouton mail du Menu et tu verras que la zone en gras et celle en italique ne sont pas reprises.

Suis-je assez précis?

Restant à dispo
0
gunbafo Messages postés 55 Date d'inscription jeudi 16 juillet 2009 Statut Membre Dernière intervention 18 février 2011 3
15 févr. 2011 à 15:08
Toujours pas de réponses????
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 8
lermite222 Messages postés 8724 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
15 févr. 2011 à 15:33
J'aimerais bien répondre mais.... y a un code passe pour le code !!!!!
0
Réponse 6 / 8
gunbafo Messages postés 55 Date d'inscription jeudi 16 juillet 2009 Statut Membre Dernière intervention 18 février 2011 3
17 févr. 2011 à 12:08
Désolé,

Je croyais l'avoir enlevé mais ça ne devait pas être le bon fichier, voic le fichier sans mot de passe:

http://www.cijoint.fr/cjlink.php?file=cj201102/cijU6gzSmh.xls

Merci
0
Réponse 7 / 8
lermite222 Messages postés 8724 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
17 févr. 2011 à 13:12
Si j'ai bien compris ??
Pas tester mais ça devrait aller... 
    With Sheets("Point Ordo-Montage FKG1")
        DernLign = .Cells(65536, 3).End(xlUp).Row
            For Lign = 3 To DernLign
                Sheets("Mail FKG1").Cells(Lign, 2) = .Cells(Lign, 2) & vbLf & .Cells(Lign, 3) & vbLf & .Cells(Lign, 5) & vbLf & .Cells(Lign, 6)
                Sheets("Mail FKG1").Cells(Lign, 3) = .Cells(Lign, 1) & vbLf & .Cells(Lign, 4) & vbLf & .Cells(Lign, 7)
                Sheets("Mail FKG1").Cells(Lign, 4) = .Cells(Lign, 8)
                Sheets("Mail FKG1").Cells(Lign, 5) = .Cells(Lign, 9)
                Sheets("Mail FKG1").Cells(Lign, 6) = .Cells(Lign, 10)
                Sheets("Mail FKG1").Cells(Lign, 7) = .Cells(Lign, 11)
                Sheets("Mail FKG1").Cells(Lign, 8) = .Cells(Lign, 12)
                Sheets("Mail FKG1").Cells(Lign, 9) = .Cells(Lign, 13)
                Sheets("Mail FKG1").Cells(Lign, 10) = .Cells(Lign, 14)
                Sheets("Mail FKG1").Cells(Lign, 11) = .Cells(Lign, 15)
              '  Sheets("Mail FKG1").Cells(Lign, 12) = .Cells(Lign, 16)
              .Cells(Lign, 16).Copy Sheets("Mail FKG1").Cells(Lign, 12)
                Sheets("Mail FKG1").Cells(Lign, 13) = .Cells(Lign, 17)
                Sheets("Mail FKG1").Cells(Lign, 14) = .Cells(Lign, 18)
            Next Lign
    End With

Exemple à retranscrire sur les autres transfert.
A+
0
Réponse 8 / 8
gunbafo Messages postés 55 Date d'inscription jeudi 16 juillet 2009 Statut Membre Dernière intervention 18 février 2011 3
18 févr. 2011 à 15:38
Nikel!

Merci lermite. ça fonctionne comme je voulais.

A+
0

Discussions similaires

Police d'écriture style "vieux journal"
joshua87 -
,,,,, -

3 réponses
Police d'écriture Ricard
ponkie -
Mike-31 -

2 réponses
changer police pseudo
Hunter -
... -

1 réponse