IHM de choix de couleur [Résolu]

[Kazuko]

Bonjour,

Je voudrais compter le nombre de mots d'une couleur donnée dans un document word. Pour cela, il suffit de parcourir le document mot par mot (ça, je sais faire ^^).
Mon problème réside en la sélection de la couleur, en effet, il faudrait que l'utilisateur puisse choisir la couleur via une IHM du même type que la petite palette de la barre d'outils (le "A" majuscule de la barre d'outils ^^).
Quelqu'un sait-il comment réaliser cette prouesse ? Après une longue recherche, je me suis retrouver avec des solutions pour Excel mais pas pour Word (je m'y prends mal peut-être )

Merci pour votre aide

[Heureux-oli]

Salut,

Je ne vois pas en Word comment faire, la boîte de dialogue est une boîte de dialogue Windows.

Pourrais-tu nous mettre ce que tu as pour Excel, ça pourrait peut-être nous donner une piste ?

[Kazuko]

Salut, merci du temps que tu m'accordes

Après ma petite matinée de recherche, j'ai trouvé ça : http://www.officekb.com/Uwe/Forum.as...r-for-Word-VBA

Code que j'ai un peu adapté pour répondre approximativement à mes besoins (c'est moche mais ça marche, ça fera l'affaire, on va pas chipoter ^^)

Je poste ma version au cas où, ça pourrait aider certains
Code à placer dans un UserForm (clic droit sur le Projet (liste de gauche) => Insertion => UserForm)

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
Private Type CHOOSECOLOR
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    rgbResult As Long
    lpCustColors As String
    Flags As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
 
Private Declare Function ChooseColorAPI Lib "comdlg32.dll" Alias _
"ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
 
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
 
Private Function GetWinwordHwnd() As Long
    Dim hWnd As Long
 
    hWnd = FindWindow("opusApp", vbNullString)
    GetWinwordHwnd = hWnd
End Function
 
Private Sub UserForm_Layout()
    Me.Hide
    Dim cc As CHOOSECOLOR
    Dim lReturn As Long
 
    cc.lStructSize = Len(cc)
    cc.hwndOwner = GetWinwordHwnd()
    cc.hInstance = 0
    cc.lpCustColors = StrConv(CustomColors, vbUnicode)
    cc.Flags = 0
 
    lReturn = ChooseColorAPI(cc)
    If lReturn <> 0 Then
        res = cc.rgbResult
        Me.BorderColor = cc.rgbResult
    End If
    Unload Me
End Sub

Ce code cache le UserForm qu'on crée (donc, autant le laisser vide ^^) et affiche la fenêtre de choix de couleur, une fois la couleur choisie, il la sauvegarde dans l'attribut "BorderColor" du UserForm et il suffit de regarder la valeur de cet attribut pour savoir quelle couleur a été choisie.
Voici un exemple d'utilisation avec le UserForm de nom "ColorChooser":

Code :

1
2
3
4
5
6
7
8
9
10
Sub a()
    Dim f As ColorChooser
    Dim colorToFind As Long
 
    Set f = ColorChooser
    f.Show
    colorToFind = f.BorderColor
 
    MsgBox (colorToFind)
End Sub

ça renvoie le nombre associé à la couleur, en le comparant avec "Font.Color" ça marche donc pas de sushis

Par contre, j'aimerais qu'un "pro" me dise si mon code est bon, s'il n'y a aucun risque de plantage ou de problème quelconque.
J'explique pourquoi, ça fait 4-5 fois que mon word plante sans raison, comme s'il y avait une boucle infinie, je me demande si c'est à cause de ma macro
EDIT: J'ai rien dit, c'était à cause d'une autre partie de ma macro (où il y avait effectivement une boucle infinie ^^") Si un "pro" veut quand même valider mon code, j'en serais ravi

Merci beaucoup, si vous avez de meilleures solutions plus propres, je suis à l'écoute

[Heureux-oli]

Salut,

Si tu n'utilises pas de UserForm, il n'est pas utile de le charger et le cacher.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
Private Sub TestOli()
    'Me.Hide
    Dim cc As CHOOSECOLOR
    Dim lReturn As Long
 
    cc.lStructSize = Len(cc)
    cc.hwndOwner = GetWinwordHwnd()
    cc.hInstance = 0
    cc.lpCustColors = StrConv("Red", vbUnicode)
    cc.Flags = 0
 
    lReturn = ChooseColorAPI(cc)
    If lReturn <> 0 Then
        'res = cc.rgbResult
       Debug.Print cc.rgbResult
    End If
    'Unload Me
End Sub

[Kazuko]

Bonjour,

Là, j'avoue que j'ai du mal à comprendre, j'ai essayé comme ça avant de poster ma "méthode sale" et ça me mettait une erreur sur le "Private Declare Function" mais là plus d'erreur, comprends pas

Enfin bref, peu importe, ça marche, merci beaucoup

Question tout de même, cela fonctionne sur word 2003, est-ce que ça fonctionnera sur les autres versions? (2000, 2007 et 2010)
Merci pour les réponses =D

[Heureux-oli]

Salut,

Ce n'est pas lié à la suite Office mai sà Windows.

Ça fonctionne sur W 7 aussi.