Chgt couleur morceau de texte VB [Résolu]

[tony020422]

Bonjour tout le monde

j'ai réalisé une macro excel assez complexe ou l'adresse client est coupée a un moment donné grâce à la commande "split" et les différents morceaux sont séparés par des "~" ..

j'utilise ensuite ces morceaux d'adresse pour remplir diffénrents documents ect.. et j'ai un pb à un moment donné, comme vous pouvez le voir sur la Pièce jointe ici, au niveau de "Adrese chantier"

http://www.cijoint.fr/cjlink.php?fil...cijqovMpwz.doc

j'aimerais mettre les "~" en blanc de facon a ne pas les voir......sauriez vous m'indiquer comment le faire?!

pur info voici comment est rempli ce champs la:

Code :

1
2
3
4
5
6
7
8
9
Private Sub Cmd_Valider_Click()
 
    Dim Adresse As String
    Adresse = Txt_Adresse01.Text & "~" & Txt_Adresse02.Text & "~" & Txt_Adresse03.Text & "~" & Txt_CP.Text & "~" & Txt_Ville.Text
    ActiveSheet.Cells(Ligne_Selectionnee, 3).Value = Adresse
 
    Call Cmd_Annuler_Click
 
End Sub

Merci par avance!

[Krovax]

Bonjour,
Sans ouvrir le fichier
Essaye quelque chose qui ressemble a ca

Code :

1
2
3
4
5
6
7
8
9
With Cells(Ligne_Selectionnee, 3)
i=len(Txt_Adresse01.Text)+1,
.Characters(Start:=i Length:=1).Font.colorindex=2
 
i=i+len(Txt_Adresse02.Text)+1,
.Characters(Start:=i, Length:=1).Font.colorindex=2
i=i+len(Txt_Adresse03.Text)+1,
.Characters(Start:=i, Length:=1).Font.colorindex=2
end with

Comme je n'ai pas testéil y aura peut être des décalage a cause des +1 qu'il faudra enlever ou laisser, je ne sais pas trop

tu ne peux pas simplement remplacer les ~ par des espace ?

Code :

 & " " &

au lien de

Code :

 & "~" &

Si tu as besoin de redécouper après ca risque fort de ne pas fonctionner

[tony020422]

Bjr Krovax

Tout d'abord merci d'etre toujours la pour nous éclairer de tes lumières!

Je vais esayer ton code tel quel en l'insérant aprés la ligne de commande que j'ai écris dans mon précédent post..

Pour l'histoire des espaces au lieu des "~" je n'ai pas essayé....je peux découper qu'avec des espaces ?! si oui alors je vais faire ca...sinon je découpe avec les "~" et je met des espaces a la place des "~" ici:

Code :

Adresse = Txt_Adresse01.Text & "~" & Txt_Adresse02.Text & "~" & Txt_Adresse03.Text & "~" & Txt_CP.Text & "~" & Txt_Ville.Text

[Krovax]

Tu peux découper avec ce que tu veux espace, retour a la ligne, virugle, le mot "Bob"....
ca donne pour découper le contenue de la variable ligne

Code :

1
2
3
4
5
dim resultat() as string
resultat=split(ligne," ")
resultat=split(ligne,chr(13)) ' de mémoire le retour a la ligne c'est le 13 il fau voir une tablea ascii
resultat=split(ligne,",")
resultat=split(ligne,"Bob")

Si tu peux avoir des espace dans la cellule autant mettre

Code :

Adresse =Txt_Adresse01.Text & " " & Txt_Adresse02.Text & " " & Txt_Adresse03.Text & " " & Txt_CP.Text & " " & Txt_Ville.Text

[nicht]

Bonjour,
Va faire un tour dans l'aide d'excel à "characters, objet".
Il y a un exemle (presque le même que celui de Krovax).
Je n'ai pas éssayé mais peut-être que quelque chose du genre:...

Code :

1
2
3
4
dim s as characters
for each s in tachaine
s.font.colorindex=2
next

...marcherait.

[tony020422]

Bonjour nicht!

Pour Krovax j'ai essayé de faire tout betement ce que j'avais dit mais ca ne marche pas! j'ai bien les "~" qui ont disparus au profit des " " mais lorsque je découpe et que je veux coller les différents morceaux dans des endroits spécifiques (signets de mes fichiers modèles .dot) j'ai une erreur...

voici le code qui permet de faire ca (ca permettra au moins a d'autres personnes de s'en inspirer si besoin!)

Code :

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
68
69
70
71
72
73
Select Case Publipostage
  Case vbYes
  
    Dim apWord, docWord, curCell As Range, chemin
    chemin = "Y:\TKAF\R04\A422\_Commun-Agence\Evelyne-carine\Dossier MOD\ISO + Doc type\"
    'créer une application Word
    Set apWord = CreateObject("word.application")
    
    'curCell = première entrée (C11)
    Set curCell = ThisWorkbook.Sheets("Feuil1").Range("C11")
    
    'tant que quelque chose est écrit dans curCell
    While curCell.Value <> vbNullString
        
        'créer un nouveau document à partir du modèle "modele\invitation.dot"

        Set docWord = apWord.Documents.Add(Template:=chemin & "Nom Client.dot")
        
        
       'aller au signet "DateJour" dans le doc Word
    apWord.Selection.Goto What:=-1, Name:="DateJour"
    'y écrire la date d'aujourd'hui formatée
    apWord.Selection.TypeText Format(Now, "dd/mm/yyyy")
    
    'aller au signet "NomChantier" dans le doc Word
    apWord.Selection.Goto What:=-1, Name:="NomChantier"
    'y écrire la valeur de C11
    apWord.Selection.TypeText ThisWorkbook.Sheets("Feuil1").Range("C11").Value
    
    apWord.Selection.Goto What:=-1, Name:="NomClient"
    apWord.Selection.TypeText ThisWorkbook.Sheets("Feuil1").Range("C15").Value
    
    Dim Adresse() As String
    Dim Temp_Adresse As String
    
    Adresse = Split(ThisWorkbook.Sheets("Feuil1").Range("C17").Value, "~")
    
     
        apWord.Selection.Goto What:=-1, Name:="AdresseClient"
        If Adresse(0) <> "" Then
            Temp_Adresse = Adresse(0)
            If Adresse(1) <> "" Then   <-- ERREUR ICI !
                Temp_Adresse = Temp_Adresse & " - " & Adresse(1)
            End If
            If Adresse(2) <> "" Then
                Temp_Adresse = Temp_Adresse & " - " & Adresse(2)
            End If
        End If
        apWord.Selection.TypeText Temp_Adresse
       
        apWord.Selection.Goto What:=-1, Name:="CPClient"
        apWord.Selection.TypeText Adresse(3)
       
        apWord.Selection.Goto What:=-1, Name:="Localiteclient"
        apWord.Selection.TypeText Adresse(4)
              
        'sauver le fichier Word (en lui donnant le nom souhaité
        apWord.ChangeFileOpenDirectory (MonRep)
        apWord.ActiveDocument.SaveAs Filename:="Plannification + Dde client ligne FT" & ".doc"
        'fermet le document Word
        docWord.Close
        
        
        'décaler curCell d'une cellule vers le bas
        Set curCell = curCell.Offset(1, 0)
    Wend
    
    'fermer l'application Word
    apWord.Quit
    
    'détruire les objets
    Set apWord = Nothing: Set docWord = Nothing: Set curCell = Nothing
    Windows.Application.Quit

Voila!

je vais essayer de ce pas ce que propose nicht!

rrra ca marche par car excel n'aime pas trop que je travaille avec les "~"..

Code :

1
2
3
4
dim ~ as characters
for each ~ in tachaine
~.font.colorindex=2
next

ca donne rien des erreurs de partout!! et remplacer les "~" par autres choses c'est quasi impossible il y en a partout...

comment faire?!

[Krovax]

Code :

1
2
3
4
dim ~ as characters
for each ~ in tachaine
~.font.colorindex=2
next

heu ca c'est très bizarre comme truc

Ceci pourrais peut etre fonctionner mais je ne connais pas le type caracters

Code :

1
2
3
4
5
6
dim ca as characters
for each ca in tachaine 'la il faut remplacer ta chaine par TA chaine de caractère que tu veux modifier
if ca= "~" then
ca.font.colorindex=2
end if
next

Sinon on est d'accord qu'avec mon code tu na pas de ~
Hors tu utilise

Code :

Adresse = Split(ThisWorkbook.Sheets("Feuil1").Range("C17").Value, "~")

Tu cherche a découper un truc qui n'a pas de ~ en utilisant ~
Du coup il découpe en un seul morceau et adress(1) n'existe pas ton tableau n'a qu'une valeur en 0
ici aussi remplace le "~" par " " pour découper en fonction des espace.

Quand le programme plante le premier reflexe avant tout autre c'est de le relancer en mode pas a pas en affichant les variable local (menue affichage variable local) tu aurais vu que tableau après le split n'avais que la dimension 0

[nicht]

Re-

Bien sûr, tachaine c'est celle que tu veux modifier.
Il fallait aussi définir s!
Bon toujours est-il que j'ai fait ceci:

Code :

1
2
3
4
5
6
7
8
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For i = 1 To Len(Range("a1"))
If Range("a1").Characters(i, 1).Text = "~" Then
Range("a1").Characters(i, 1).Font.ColorIndex = 2
End If
Next
 
End Sub

En espérent t'avoir apporté une réponse

Si tu préfères, tu peux aussi faire comme ça:

Code :

1
2
3
4
5
6
7
8
9
chaine = Feuil1.Range("a1").Value
For i = 6 To Len(chaine)
 
 
 
a = InStr(i, chaine, "~")
Feuil1.Range("a1").Characters(a, 1).Font.ColorIndex = 5
Feuil1.Range("a1").Characters(1, 1).Font.ColorIndex = 1
Next

Mais il y a une ligne en plus!

[tony020422]

Re messeiurs, désolé mais j'étais en réunion..

alors j'ai mis ca:

Code :

Adresse = Split(ThisWorkbook.Sheets("Feuil1").Range("C17").Value, " ")

et ca

Code :

Adresse =Txt_Adresse01.Text & " " & Txt_Adresse02.Text & " " & Txt_Adresse03.Text & " " & Txt_CP.Text & " " & Txt_Ville.Text

mais j'ai tjs la mm erreur au mm endroit que tt a l'heure! (cf post de 11h53)

je vais alors tenter desormais le script de nicht de 14h17.........

alors je comprends pas un truc!

le formulaire dans lequel je tape toutes les infos fonctionne, les "~" sont bien blancs (cf piece jointe) mais lorsque j'envoi le contenu de mes cellules au niveau des signets de mon .dot....et bien les "~" apparaissent en noir !!

est du a mes .dot ou a autre chose ?! parce que le je comprends pas!!

oups autant pour moi ce n'est pas un .dot mais bien un .doc en ecriture protégé que j'utilise...en mettant ce qu'il faut dans les seuls endroits disponibles du document (case grisée)

le voila ce .dco en piece jointe!

[tony020422]

a ben c'est bon en réfléchissant bien la desdus:

Tu cherche a découper un truc qui n'a pas de ~ en utilisant ~
Du coup il découpe en un seul morceau et adress(1) n'existe pas ton tableau n'a qu'une valeur en 0
ici aussi remplace le "~" par " " pour découper en fonction des espace.

Quand le programme plante le premier reflexe avant tout autre c'est de le relancer en mode pas a pas en affichant les variable local (menue affichage variable local) tu aurais vu que tableau après le split n'avais que la dimension 0

j'ai réussi a faire en sorte que ca marche comme je veux!

Merci beuacoup a tous les 2 messieurs pour votre implication votre patience et votre générosité!!

Je vous souhaite de passer une agréable fin de journée et un bon week end!

A bientot sur developpez !!