| Est-il possible avec d'attribuer à l'expression
| application.statusbar="xxxxxxx" une couleur?
Si tu trouves, tu viens nous le dire !
Je ne crois pas que Bilou a prévu ça comme possibilité
| Est-il possible avec d'attribuer à l'expression
| application.statusbar="xxxxxxx" une couleur?
Si tu trouves, tu viens nous le dire !
Je ne crois pas que Bilou a prévu ça comme possibilité
| Est-il possible avec d'attribuer à l'expression
| application.statusbar="xxxxxxx" une couleur?
Si tu trouves, tu viens nous le dire !
Je ne crois pas que Bilou a prévu ça comme possibilité
bonjour
Est-il possible avec d'attribuer à l'expression
application.statusbar="xxxxxxx" une couleur?
je ne trouve rien qui fonctionne...
Merci
Lionel
bonjour
Est-il possible avec d'attribuer à l'expression
application.statusbar="xxxxxxx" une couleur?
je ne trouve rien qui fonctionne...
Merci
Lionel
bonjour
Est-il possible avec d'attribuer à l'expression
application.statusbar="xxxxxxx" une couleur?
je ne trouve rien qui fonctionne...
Merci
Lionel
bonjour
Est-il possible avec d'attribuer à l'expression
application.statusbar="xxxxxxx" une couleur?
je ne trouve rien qui fonctionne...
Merci
Lionel
bonjour
Est-il possible avec d'attribuer à l'expression
application.statusbar="xxxxxxx" une couleur?
je ne trouve rien qui fonctionne...
Merci
Lionel
bonjour
Est-il possible avec d'attribuer à l'expression
application.statusbar="xxxxxxx" une couleur?
je ne trouve rien qui fonctionne...
Merci
Lionel
Bonjour Lionel;
Ce n'est pas prévu en natif; pour ce faire, il faut ruser.
Exemple, dans un module standard (police Times New Roman en rouge) :
Private Declare Function FindWindow& Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function FindWindowEx& Lib "user32" _
Alias "FindWindowExA" (ByVal hWnd1&, ByVal hWnd2& _
, ByVal lpsz1$, ByVal lpsz2$)
Private Declare Function GetDC& Lib "user32" (ByVal hWnd&)
' New color
Private Declare Function GetTextColor& Lib "gdi32" (ByVal hdc&)
Private Declare Function SetTextColor& Lib "gdi32" (ByVal hdc&, ByVal
crColor&)
' New police
Private Declare Function CreateFont& Lib "gdi32" Alias _
"CreateFontA" (ByVal nHeight&, ByVal nWidth& _
, ByVal nEscapement&, ByVal nOrientation&, ByVal fnWeight& _
, ByVal fdwItalic As Boolean, ByVal fdwUnderline As Boolean _
, ByVal fdwStrikeOut As Boolean, ByVal fdwCharSet& _
, ByVal fdwOutputPrecision&, ByVal fdwClipPrecision& _
, ByVal fdwQuality&, ByVal fdwPitchAndFamily&, ByVal lpszFace$)
Private Declare Function SelectObject& _
Lib "gdi32" (ByVal hdc&, ByVal hObject&)
Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject&)
Private Declare Function ReleaseDC& Lib "user32" (ByVal hWnd&, ByVal hdc&)
Sub StatusBarTest()
Dim BarState As Boolean, hWnd&, hdc&, hFont&, hObj&, Color&
BarState = Application.DisplayStatusBar
Application.DisplayStatusBar = True
hWnd = FindWindow(vbNullString, Application.Caption)
hWnd = FindWindowEx(hWnd, ByVal 0&, "EXCEL4", vbNullString)
hdc = GetDC(hWnd)
Color = GetTextColor(hdc)
SetTextColor hdc, RGB(255, 0, 0)
hFont = CreateFont(-12, 0, 0, 0, 700, 1, 1, 0, 0, 0, 0, 0, 0, "Times New
Roman")
hObj = SelectObject(hdc, hFont)
Application.StatusBar = "This is my new police for StatusBar !"
MsgBox "How's that ?", 64
Application.StatusBar = False
SelectObject hdc, hObj
DeleteObject hFont
SetTextColor hdc, Color
ReleaseDC hWnd, hdc
Application.DisplayStatusBar = BarState
End Sub
"Lionel" a écrit dans le message de news:
462dd468$0$27404$bonjour
Est-il possible avec d'attribuer à l'expression
application.statusbar="xxxxxxx" une couleur?
je ne trouve rien qui fonctionne...
Merci
Lionel
Bonjour Lionel;
Ce n'est pas prévu en natif; pour ce faire, il faut ruser.
Exemple, dans un module standard (police Times New Roman en rouge) :
Private Declare Function FindWindow& Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function FindWindowEx& Lib "user32" _
Alias "FindWindowExA" (ByVal hWnd1&, ByVal hWnd2& _
, ByVal lpsz1$, ByVal lpsz2$)
Private Declare Function GetDC& Lib "user32" (ByVal hWnd&)
' New color
Private Declare Function GetTextColor& Lib "gdi32" (ByVal hdc&)
Private Declare Function SetTextColor& Lib "gdi32" (ByVal hdc&, ByVal
crColor&)
' New police
Private Declare Function CreateFont& Lib "gdi32" Alias _
"CreateFontA" (ByVal nHeight&, ByVal nWidth& _
, ByVal nEscapement&, ByVal nOrientation&, ByVal fnWeight& _
, ByVal fdwItalic As Boolean, ByVal fdwUnderline As Boolean _
, ByVal fdwStrikeOut As Boolean, ByVal fdwCharSet& _
, ByVal fdwOutputPrecision&, ByVal fdwClipPrecision& _
, ByVal fdwQuality&, ByVal fdwPitchAndFamily&, ByVal lpszFace$)
Private Declare Function SelectObject& _
Lib "gdi32" (ByVal hdc&, ByVal hObject&)
Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject&)
Private Declare Function ReleaseDC& Lib "user32" (ByVal hWnd&, ByVal hdc&)
Sub StatusBarTest()
Dim BarState As Boolean, hWnd&, hdc&, hFont&, hObj&, Color&
BarState = Application.DisplayStatusBar
Application.DisplayStatusBar = True
hWnd = FindWindow(vbNullString, Application.Caption)
hWnd = FindWindowEx(hWnd, ByVal 0&, "EXCEL4", vbNullString)
hdc = GetDC(hWnd)
Color = GetTextColor(hdc)
SetTextColor hdc, RGB(255, 0, 0)
hFont = CreateFont(-12, 0, 0, 0, 700, 1, 1, 0, 0, 0, 0, 0, 0, "Times New
Roman")
hObj = SelectObject(hdc, hFont)
Application.StatusBar = "This is my new police for StatusBar !"
MsgBox "How's that ?", 64
Application.StatusBar = False
SelectObject hdc, hObj
DeleteObject hFont
SetTextColor hdc, Color
ReleaseDC hWnd, hdc
Application.DisplayStatusBar = BarState
End Sub
"Lionel" <lionel.ma@wanadoo.fr> a écrit dans le message de news:
462dd468$0$27404$ba4acef3@news.orange.fr...
bonjour
Est-il possible avec d'attribuer à l'expression
application.statusbar="xxxxxxx" une couleur?
je ne trouve rien qui fonctionne...
Merci
Lionel
Bonjour Lionel;
Ce n'est pas prévu en natif; pour ce faire, il faut ruser.
Exemple, dans un module standard (police Times New Roman en rouge) :
Private Declare Function FindWindow& Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function FindWindowEx& Lib "user32" _
Alias "FindWindowExA" (ByVal hWnd1&, ByVal hWnd2& _
, ByVal lpsz1$, ByVal lpsz2$)
Private Declare Function GetDC& Lib "user32" (ByVal hWnd&)
' New color
Private Declare Function GetTextColor& Lib "gdi32" (ByVal hdc&)
Private Declare Function SetTextColor& Lib "gdi32" (ByVal hdc&, ByVal
crColor&)
' New police
Private Declare Function CreateFont& Lib "gdi32" Alias _
"CreateFontA" (ByVal nHeight&, ByVal nWidth& _
, ByVal nEscapement&, ByVal nOrientation&, ByVal fnWeight& _
, ByVal fdwItalic As Boolean, ByVal fdwUnderline As Boolean _
, ByVal fdwStrikeOut As Boolean, ByVal fdwCharSet& _
, ByVal fdwOutputPrecision&, ByVal fdwClipPrecision& _
, ByVal fdwQuality&, ByVal fdwPitchAndFamily&, ByVal lpszFace$)
Private Declare Function SelectObject& _
Lib "gdi32" (ByVal hdc&, ByVal hObject&)
Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject&)
Private Declare Function ReleaseDC& Lib "user32" (ByVal hWnd&, ByVal hdc&)
Sub StatusBarTest()
Dim BarState As Boolean, hWnd&, hdc&, hFont&, hObj&, Color&
BarState = Application.DisplayStatusBar
Application.DisplayStatusBar = True
hWnd = FindWindow(vbNullString, Application.Caption)
hWnd = FindWindowEx(hWnd, ByVal 0&, "EXCEL4", vbNullString)
hdc = GetDC(hWnd)
Color = GetTextColor(hdc)
SetTextColor hdc, RGB(255, 0, 0)
hFont = CreateFont(-12, 0, 0, 0, 700, 1, 1, 0, 0, 0, 0, 0, 0, "Times New
Roman")
hObj = SelectObject(hdc, hFont)
Application.StatusBar = "This is my new police for StatusBar !"
MsgBox "How's that ?", 64
Application.StatusBar = False
SelectObject hdc, hObj
DeleteObject hFont
SetTextColor hdc, Color
ReleaseDC hWnd, hdc
Application.DisplayStatusBar = BarState
End Sub
"Lionel" a écrit dans le message de news:
462dd468$0$27404$bonjour
Est-il possible avec d'attribuer à l'expression
application.statusbar="xxxxxxx" une couleur?
je ne trouve rien qui fonctionne...
Merci
Lionel
Bonjour Lionel;
Ce n'est pas prévu en natif; pour ce faire, il faut ruser.
Exemple, dans un module standard (police Times New Roman en rouge) :
Private Declare Function FindWindow& Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function FindWindowEx& Lib "user32" _
Alias "FindWindowExA" (ByVal hWnd1&, ByVal hWnd2& _
, ByVal lpsz1$, ByVal lpsz2$)
Private Declare Function GetDC& Lib "user32" (ByVal hWnd&)
' New color
Private Declare Function GetTextColor& Lib "gdi32" (ByVal hdc&)
Private Declare Function SetTextColor& Lib "gdi32" (ByVal hdc&, ByVal
crColor&)
' New police
Private Declare Function CreateFont& Lib "gdi32" Alias _
"CreateFontA" (ByVal nHeight&, ByVal nWidth& _
, ByVal nEscapement&, ByVal nOrientation&, ByVal fnWeight& _
, ByVal fdwItalic As Boolean, ByVal fdwUnderline As Boolean _
, ByVal fdwStrikeOut As Boolean, ByVal fdwCharSet& _
, ByVal fdwOutputPrecision&, ByVal fdwClipPrecision& _
, ByVal fdwQuality&, ByVal fdwPitchAndFamily&, ByVal lpszFace$)
Private Declare Function SelectObject& _
Lib "gdi32" (ByVal hdc&, ByVal hObject&)
Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject&)
Private Declare Function ReleaseDC& Lib "user32" (ByVal hWnd&, ByVal hdc&)
Sub StatusBarTest()
Dim BarState As Boolean, hWnd&, hdc&, hFont&, hObj&, Color&
BarState = Application.DisplayStatusBar
Application.DisplayStatusBar = True
hWnd = FindWindow(vbNullString, Application.Caption)
hWnd = FindWindowEx(hWnd, ByVal 0&, "EXCEL4", vbNullString)
hdc = GetDC(hWnd)
Color = GetTextColor(hdc)
SetTextColor hdc, RGB(255, 0, 0)
hFont = CreateFont(-12, 0, 0, 0, 700, 1, 1, 0, 0, 0, 0, 0, 0, "Times New
Roman")
hObj = SelectObject(hdc, hFont)
Application.StatusBar = "This is my new police for StatusBar !"
MsgBox "How's that ?", 64
Application.StatusBar = False
SelectObject hdc, hObj
DeleteObject hFont
SetTextColor hdc, Color
ReleaseDC hWnd, hdc
Application.DisplayStatusBar = BarState
End Sub
"Lionel" a écrit dans le message de news:
462dd468$0$27404$bonjour
Est-il possible avec d'attribuer à l'expression
application.statusbar="xxxxxxx" une couleur?
je ne trouve rien qui fonctionne...
Merci
Lionel
Bonjour Lionel;
Ce n'est pas prévu en natif; pour ce faire, il faut ruser.
Exemple, dans un module standard (police Times New Roman en rouge) :
Private Declare Function FindWindow& Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function FindWindowEx& Lib "user32" _
Alias "FindWindowExA" (ByVal hWnd1&, ByVal hWnd2& _
, ByVal lpsz1$, ByVal lpsz2$)
Private Declare Function GetDC& Lib "user32" (ByVal hWnd&)
' New color
Private Declare Function GetTextColor& Lib "gdi32" (ByVal hdc&)
Private Declare Function SetTextColor& Lib "gdi32" (ByVal hdc&, ByVal
crColor&)
' New police
Private Declare Function CreateFont& Lib "gdi32" Alias _
"CreateFontA" (ByVal nHeight&, ByVal nWidth& _
, ByVal nEscapement&, ByVal nOrientation&, ByVal fnWeight& _
, ByVal fdwItalic As Boolean, ByVal fdwUnderline As Boolean _
, ByVal fdwStrikeOut As Boolean, ByVal fdwCharSet& _
, ByVal fdwOutputPrecision&, ByVal fdwClipPrecision& _
, ByVal fdwQuality&, ByVal fdwPitchAndFamily&, ByVal lpszFace$)
Private Declare Function SelectObject& _
Lib "gdi32" (ByVal hdc&, ByVal hObject&)
Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject&)
Private Declare Function ReleaseDC& Lib "user32" (ByVal hWnd&, ByVal hdc&)
Sub StatusBarTest()
Dim BarState As Boolean, hWnd&, hdc&, hFont&, hObj&, Color&
BarState = Application.DisplayStatusBar
Application.DisplayStatusBar = True
hWnd = FindWindow(vbNullString, Application.Caption)
hWnd = FindWindowEx(hWnd, ByVal 0&, "EXCEL4", vbNullString)
hdc = GetDC(hWnd)
Color = GetTextColor(hdc)
SetTextColor hdc, RGB(255, 0, 0)
hFont = CreateFont(-12, 0, 0, 0, 700, 1, 1, 0, 0, 0, 0, 0, 0, "Times New
Roman")
hObj = SelectObject(hdc, hFont)
Application.StatusBar = "This is my new police for StatusBar !"
MsgBox "How's that ?", 64
Application.StatusBar = False
SelectObject hdc, hObj
DeleteObject hFont
SetTextColor hdc, Color
ReleaseDC hWnd, hdc
Application.DisplayStatusBar = BarState
End Sub
"Lionel" <lionel.ma@wanadoo.fr> a écrit dans le message de news:
462dd468$0$27404$ba4acef3@news.orange.fr...
bonjour
Est-il possible avec d'attribuer à l'expression
application.statusbar="xxxxxxx" une couleur?
je ne trouve rien qui fonctionne...
Merci
Lionel
Bonjour Lionel;
Ce n'est pas prévu en natif; pour ce faire, il faut ruser.
Exemple, dans un module standard (police Times New Roman en rouge) :
Private Declare Function FindWindow& Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function FindWindowEx& Lib "user32" _
Alias "FindWindowExA" (ByVal hWnd1&, ByVal hWnd2& _
, ByVal lpsz1$, ByVal lpsz2$)
Private Declare Function GetDC& Lib "user32" (ByVal hWnd&)
' New color
Private Declare Function GetTextColor& Lib "gdi32" (ByVal hdc&)
Private Declare Function SetTextColor& Lib "gdi32" (ByVal hdc&, ByVal
crColor&)
' New police
Private Declare Function CreateFont& Lib "gdi32" Alias _
"CreateFontA" (ByVal nHeight&, ByVal nWidth& _
, ByVal nEscapement&, ByVal nOrientation&, ByVal fnWeight& _
, ByVal fdwItalic As Boolean, ByVal fdwUnderline As Boolean _
, ByVal fdwStrikeOut As Boolean, ByVal fdwCharSet& _
, ByVal fdwOutputPrecision&, ByVal fdwClipPrecision& _
, ByVal fdwQuality&, ByVal fdwPitchAndFamily&, ByVal lpszFace$)
Private Declare Function SelectObject& _
Lib "gdi32" (ByVal hdc&, ByVal hObject&)
Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject&)
Private Declare Function ReleaseDC& Lib "user32" (ByVal hWnd&, ByVal hdc&)
Sub StatusBarTest()
Dim BarState As Boolean, hWnd&, hdc&, hFont&, hObj&, Color&
BarState = Application.DisplayStatusBar
Application.DisplayStatusBar = True
hWnd = FindWindow(vbNullString, Application.Caption)
hWnd = FindWindowEx(hWnd, ByVal 0&, "EXCEL4", vbNullString)
hdc = GetDC(hWnd)
Color = GetTextColor(hdc)
SetTextColor hdc, RGB(255, 0, 0)
hFont = CreateFont(-12, 0, 0, 0, 700, 1, 1, 0, 0, 0, 0, 0, 0, "Times New
Roman")
hObj = SelectObject(hdc, hFont)
Application.StatusBar = "This is my new police for StatusBar !"
MsgBox "How's that ?", 64
Application.StatusBar = False
SelectObject hdc, hObj
DeleteObject hFont
SetTextColor hdc, Color
ReleaseDC hWnd, hdc
Application.DisplayStatusBar = BarState
End Sub
"Lionel" a écrit dans le message de news:
462dd468$0$27404$bonjour
Est-il possible avec d'attribuer à l'expression
application.statusbar="xxxxxxx" une couleur?
je ne trouve rien qui fonctionne...
Merci
Lionel
Un petit mot avant d'aller plus loin, si tu insères dans ton application
des trucs compliqués, tu risques d'avoir des difficultés à faire
l'entretien
de ton application ....
Dans un module standard, tu copies dans le haut la déclaration des API
'-----------------------------------
Private Declare Function FindWindow& Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function FindWindowEx& Lib "user32" _
Alias "FindWindowExA" (ByVal hWnd1&, ByVal hWnd2& _
, ByVal lpsz1$, ByVal lpsz2$)
Private Declare Function GetDC& Lib "user32" (ByVal hWnd&)
' New color
Private Declare Function GetTextColor& Lib "gdi32" (ByVal hdc&)
Private Declare Function SetTextColor& Lib "gdi32" (ByVal hdc&, ByVal
crColor&)
' New police
Private Declare Function CreateFont& Lib "gdi32" Alias _
"CreateFontA" (ByVal nHeight&, ByVal nWidth& _
, ByVal nEscapement&, ByVal nOrientation&, ByVal fnWeight& _
, ByVal fdwItalic As Boolean, ByVal fdwUnderline As Boolean _
, ByVal fdwStrikeOut As Boolean, ByVal fdwCharSet& _
, ByVal fdwOutputPrecision&, ByVal fdwClipPrecision& _
, ByVal fdwQuality&, ByVal fdwPitchAndFamily&, ByVal lpszFace$)
Private Declare Function SelectObject& _
Lib "gdi32" (ByVal hdc&, ByVal hObject&)
Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject&)
Private Declare Function ReleaseDC& Lib "user32" (ByVal hWnd&, ByVal hdc&)
'-----------------------------------
Cette procédure doit être dans le même module que ce qui précède pour
être capable d'accéder aux API déclarer comme Private
'------------------------------------
Sub StatusBarTest(Message As String)
Dim BarState As Boolean, hWnd&, hdc&, hFont&, hObj&, Color&
BarState = Application.DisplayStatusBar
Application.DisplayStatusBar = True
hWnd = FindWindow(vbNullString, Application.Caption)
hWnd = FindWindowEx(hWnd, ByVal 0&, "EXCEL4", vbNullString)
hdc = GetDC(hWnd)
Color = GetTextColor(hdc)
SetTextColor hdc, RGB(255, 0, 0)
hFont = CreateFont(-12, 0, 0, 0, 700, 1, 1, 0, 0, 0, 0, 0, 0, "Times New
Roman ")
hObj = SelectObject(hdc, hFont)
Application.StatusBar = Message
MsgBox "How's that ?", 64
Application.StatusBar = False
SelectObject hdc, hObj
DeleteObject hFont
SetTextColor hdc, Color
ReleaseDC hWnd, hdc
Application.DisplayStatusBar = BarState
End Sub
'------------------------------------
Dans ta procédure générale, tu n'as qu'à inclure ces 3 lignes de codes
Dim Message As String
Message = "Tu te compllques la vie."
StatusBarTest Message
Dans la procédure "StatusBarTest", il y a cette ligne de code :
MsgBox "How's that ?", 64
que tu dois désactiver. Elle est là pour faire en sorte que dans
l'exemple originale, tu as le temps de voir le message s'afficher
en rouge car le message le sera que durant le temps que durera
l'exécution de la tâche... si cette dernière est trop courte, tu percevras
rien. Tu n'as qu'à placer une apostrophe devant la ligne.
'------------------------------------
Sub Exemple()
Dim Message As String
Message = "Tu te compliques la vie."
'Au moment d'afficher ton message dans ta procédure
'tu écris :
StatusBarTest Message
End Sub
'------------------------------------
"Lionel" a écrit dans le message de news:
462fb25d$0$5105$
Bonsoir
Merci pour cette reponse mais j'ai une question certainement bete :
comment
j'utilise ca dans un cas reel
J'ai ma macro qui regulierment pendant son execution modifie le message
statusbar
Je reporte toutes ces lignes systematiquement?
Merci de m'eclairer car a priori je comprends pas le code alors si en plus
je sais pas ou le mettre ... Ca peut paraitre ridicule mais je peux pas
evoluer si j'ai pas certaines explications concernant les codes...
Merci Lionel
"Michel Pierron" a écrit dans le message de news:Bonjour Lionel;
Ce n'est pas prévu en natif; pour ce faire, il faut ruser.
Exemple, dans un module standard (police Times New Roman en rouge) :
Private Declare Function FindWindow& Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function FindWindowEx& Lib "user32" _
Alias "FindWindowExA" (ByVal hWnd1&, ByVal hWnd2& _
, ByVal lpsz1$, ByVal lpsz2$)
Private Declare Function GetDC& Lib "user32" (ByVal hWnd&)
' New color
Private Declare Function GetTextColor& Lib "gdi32" (ByVal hdc&)
Private Declare Function SetTextColor& Lib "gdi32" (ByVal hdc&, ByVal
crColor&)
' New police
Private Declare Function CreateFont& Lib "gdi32" Alias _
"CreateFontA" (ByVal nHeight&, ByVal nWidth& _
, ByVal nEscapement&, ByVal nOrientation&, ByVal fnWeight& _
, ByVal fdwItalic As Boolean, ByVal fdwUnderline As Boolean _
, ByVal fdwStrikeOut As Boolean, ByVal fdwCharSet& _
, ByVal fdwOutputPrecision&, ByVal fdwClipPrecision& _
, ByVal fdwQuality&, ByVal fdwPitchAndFamily&, ByVal lpszFace$)
Private Declare Function SelectObject& _
Lib "gdi32" (ByVal hdc&, ByVal hObject&)
Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject&)
Private Declare Function ReleaseDC& Lib "user32" (ByVal hWnd&, ByVal
hdc&)
Sub StatusBarTest()
Dim BarState As Boolean, hWnd&, hdc&, hFont&, hObj&, Color&
BarState = Application.DisplayStatusBar
Application.DisplayStatusBar = True
hWnd = FindWindow(vbNullString, Application.Caption)
hWnd = FindWindowEx(hWnd, ByVal 0&, "EXCEL4", vbNullString)
hdc = GetDC(hWnd)
Color = GetTextColor(hdc)
SetTextColor hdc, RGB(255, 0, 0)
hFont = CreateFont(-12, 0, 0, 0, 700, 1, 1, 0, 0, 0, 0, 0, 0, "Times New
Roman")
hObj = SelectObject(hdc, hFont)
Application.StatusBar = "This is my new police for StatusBar !"
MsgBox "How's that ?", 64
Application.StatusBar = False
SelectObject hdc, hObj
DeleteObject hFont
SetTextColor hdc, Color
ReleaseDC hWnd, hdc
Application.DisplayStatusBar = BarState
End Sub
"Lionel" a écrit dans le message de news:
462dd468$0$27404$bonjour
Est-il possible avec d'attribuer à l'expression
application.statusbar="xxxxxxx" une couleur?
je ne trouve rien qui fonctionne...
Merci
Lionel
Un petit mot avant d'aller plus loin, si tu insères dans ton application
des trucs compliqués, tu risques d'avoir des difficultés à faire
l'entretien
de ton application ....
Dans un module standard, tu copies dans le haut la déclaration des API
'-----------------------------------
Private Declare Function FindWindow& Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function FindWindowEx& Lib "user32" _
Alias "FindWindowExA" (ByVal hWnd1&, ByVal hWnd2& _
, ByVal lpsz1$, ByVal lpsz2$)
Private Declare Function GetDC& Lib "user32" (ByVal hWnd&)
' New color
Private Declare Function GetTextColor& Lib "gdi32" (ByVal hdc&)
Private Declare Function SetTextColor& Lib "gdi32" (ByVal hdc&, ByVal
crColor&)
' New police
Private Declare Function CreateFont& Lib "gdi32" Alias _
"CreateFontA" (ByVal nHeight&, ByVal nWidth& _
, ByVal nEscapement&, ByVal nOrientation&, ByVal fnWeight& _
, ByVal fdwItalic As Boolean, ByVal fdwUnderline As Boolean _
, ByVal fdwStrikeOut As Boolean, ByVal fdwCharSet& _
, ByVal fdwOutputPrecision&, ByVal fdwClipPrecision& _
, ByVal fdwQuality&, ByVal fdwPitchAndFamily&, ByVal lpszFace$)
Private Declare Function SelectObject& _
Lib "gdi32" (ByVal hdc&, ByVal hObject&)
Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject&)
Private Declare Function ReleaseDC& Lib "user32" (ByVal hWnd&, ByVal hdc&)
'-----------------------------------
Cette procédure doit être dans le même module que ce qui précède pour
être capable d'accéder aux API déclarer comme Private
'------------------------------------
Sub StatusBarTest(Message As String)
Dim BarState As Boolean, hWnd&, hdc&, hFont&, hObj&, Color&
BarState = Application.DisplayStatusBar
Application.DisplayStatusBar = True
hWnd = FindWindow(vbNullString, Application.Caption)
hWnd = FindWindowEx(hWnd, ByVal 0&, "EXCEL4", vbNullString)
hdc = GetDC(hWnd)
Color = GetTextColor(hdc)
SetTextColor hdc, RGB(255, 0, 0)
hFont = CreateFont(-12, 0, 0, 0, 700, 1, 1, 0, 0, 0, 0, 0, 0, "Times New
Roman ")
hObj = SelectObject(hdc, hFont)
Application.StatusBar = Message
MsgBox "How's that ?", 64
Application.StatusBar = False
SelectObject hdc, hObj
DeleteObject hFont
SetTextColor hdc, Color
ReleaseDC hWnd, hdc
Application.DisplayStatusBar = BarState
End Sub
'------------------------------------
Dans ta procédure générale, tu n'as qu'à inclure ces 3 lignes de codes
Dim Message As String
Message = "Tu te compllques la vie."
StatusBarTest Message
Dans la procédure "StatusBarTest", il y a cette ligne de code :
MsgBox "How's that ?", 64
que tu dois désactiver. Elle est là pour faire en sorte que dans
l'exemple originale, tu as le temps de voir le message s'afficher
en rouge car le message le sera que durant le temps que durera
l'exécution de la tâche... si cette dernière est trop courte, tu percevras
rien. Tu n'as qu'à placer une apostrophe devant la ligne.
'------------------------------------
Sub Exemple()
Dim Message As String
Message = "Tu te compliques la vie."
'Au moment d'afficher ton message dans ta procédure
'tu écris :
StatusBarTest Message
End Sub
'------------------------------------
"Lionel" <lionel.ma@wanadoo.fr> a écrit dans le message de news:
462fb25d$0$5105$ba4acef3@news.orange.fr...
Bonsoir
Merci pour cette reponse mais j'ai une question certainement bete :
comment
j'utilise ca dans un cas reel
J'ai ma macro qui regulierment pendant son execution modifie le message
statusbar
Je reporte toutes ces lignes systematiquement?
Merci de m'eclairer car a priori je comprends pas le code alors si en plus
je sais pas ou le mettre ... Ca peut paraitre ridicule mais je peux pas
evoluer si j'ai pas certaines explications concernant les codes...
Merci Lionel
"Michel Pierron" <michel.pierron@free.fr> a écrit dans le message de news:
um3PEwmhHHA.4872@TK2MSFTNGP03.phx.gbl...
Bonjour Lionel;
Ce n'est pas prévu en natif; pour ce faire, il faut ruser.
Exemple, dans un module standard (police Times New Roman en rouge) :
Private Declare Function FindWindow& Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function FindWindowEx& Lib "user32" _
Alias "FindWindowExA" (ByVal hWnd1&, ByVal hWnd2& _
, ByVal lpsz1$, ByVal lpsz2$)
Private Declare Function GetDC& Lib "user32" (ByVal hWnd&)
' New color
Private Declare Function GetTextColor& Lib "gdi32" (ByVal hdc&)
Private Declare Function SetTextColor& Lib "gdi32" (ByVal hdc&, ByVal
crColor&)
' New police
Private Declare Function CreateFont& Lib "gdi32" Alias _
"CreateFontA" (ByVal nHeight&, ByVal nWidth& _
, ByVal nEscapement&, ByVal nOrientation&, ByVal fnWeight& _
, ByVal fdwItalic As Boolean, ByVal fdwUnderline As Boolean _
, ByVal fdwStrikeOut As Boolean, ByVal fdwCharSet& _
, ByVal fdwOutputPrecision&, ByVal fdwClipPrecision& _
, ByVal fdwQuality&, ByVal fdwPitchAndFamily&, ByVal lpszFace$)
Private Declare Function SelectObject& _
Lib "gdi32" (ByVal hdc&, ByVal hObject&)
Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject&)
Private Declare Function ReleaseDC& Lib "user32" (ByVal hWnd&, ByVal
hdc&)
Sub StatusBarTest()
Dim BarState As Boolean, hWnd&, hdc&, hFont&, hObj&, Color&
BarState = Application.DisplayStatusBar
Application.DisplayStatusBar = True
hWnd = FindWindow(vbNullString, Application.Caption)
hWnd = FindWindowEx(hWnd, ByVal 0&, "EXCEL4", vbNullString)
hdc = GetDC(hWnd)
Color = GetTextColor(hdc)
SetTextColor hdc, RGB(255, 0, 0)
hFont = CreateFont(-12, 0, 0, 0, 700, 1, 1, 0, 0, 0, 0, 0, 0, "Times New
Roman")
hObj = SelectObject(hdc, hFont)
Application.StatusBar = "This is my new police for StatusBar !"
MsgBox "How's that ?", 64
Application.StatusBar = False
SelectObject hdc, hObj
DeleteObject hFont
SetTextColor hdc, Color
ReleaseDC hWnd, hdc
Application.DisplayStatusBar = BarState
End Sub
"Lionel" <lionel.ma@wanadoo.fr> a écrit dans le message de news:
462dd468$0$27404$ba4acef3@news.orange.fr...
bonjour
Est-il possible avec d'attribuer à l'expression
application.statusbar="xxxxxxx" une couleur?
je ne trouve rien qui fonctionne...
Merci
Lionel
Un petit mot avant d'aller plus loin, si tu insères dans ton application
des trucs compliqués, tu risques d'avoir des difficultés à faire
l'entretien
de ton application ....
Dans un module standard, tu copies dans le haut la déclaration des API
'-----------------------------------
Private Declare Function FindWindow& Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function FindWindowEx& Lib "user32" _
Alias "FindWindowExA" (ByVal hWnd1&, ByVal hWnd2& _
, ByVal lpsz1$, ByVal lpsz2$)
Private Declare Function GetDC& Lib "user32" (ByVal hWnd&)
' New color
Private Declare Function GetTextColor& Lib "gdi32" (ByVal hdc&)
Private Declare Function SetTextColor& Lib "gdi32" (ByVal hdc&, ByVal
crColor&)
' New police
Private Declare Function CreateFont& Lib "gdi32" Alias _
"CreateFontA" (ByVal nHeight&, ByVal nWidth& _
, ByVal nEscapement&, ByVal nOrientation&, ByVal fnWeight& _
, ByVal fdwItalic As Boolean, ByVal fdwUnderline As Boolean _
, ByVal fdwStrikeOut As Boolean, ByVal fdwCharSet& _
, ByVal fdwOutputPrecision&, ByVal fdwClipPrecision& _
, ByVal fdwQuality&, ByVal fdwPitchAndFamily&, ByVal lpszFace$)
Private Declare Function SelectObject& _
Lib "gdi32" (ByVal hdc&, ByVal hObject&)
Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject&)
Private Declare Function ReleaseDC& Lib "user32" (ByVal hWnd&, ByVal hdc&)
'-----------------------------------
Cette procédure doit être dans le même module que ce qui précède pour
être capable d'accéder aux API déclarer comme Private
'------------------------------------
Sub StatusBarTest(Message As String)
Dim BarState As Boolean, hWnd&, hdc&, hFont&, hObj&, Color&
BarState = Application.DisplayStatusBar
Application.DisplayStatusBar = True
hWnd = FindWindow(vbNullString, Application.Caption)
hWnd = FindWindowEx(hWnd, ByVal 0&, "EXCEL4", vbNullString)
hdc = GetDC(hWnd)
Color = GetTextColor(hdc)
SetTextColor hdc, RGB(255, 0, 0)
hFont = CreateFont(-12, 0, 0, 0, 700, 1, 1, 0, 0, 0, 0, 0, 0, "Times New
Roman ")
hObj = SelectObject(hdc, hFont)
Application.StatusBar = Message
MsgBox "How's that ?", 64
Application.StatusBar = False
SelectObject hdc, hObj
DeleteObject hFont
SetTextColor hdc, Color
ReleaseDC hWnd, hdc
Application.DisplayStatusBar = BarState
End Sub
'------------------------------------
Dans ta procédure générale, tu n'as qu'à inclure ces 3 lignes de codes
Dim Message As String
Message = "Tu te compllques la vie."
StatusBarTest Message
Dans la procédure "StatusBarTest", il y a cette ligne de code :
MsgBox "How's that ?", 64
que tu dois désactiver. Elle est là pour faire en sorte que dans
l'exemple originale, tu as le temps de voir le message s'afficher
en rouge car le message le sera que durant le temps que durera
l'exécution de la tâche... si cette dernière est trop courte, tu percevras
rien. Tu n'as qu'à placer une apostrophe devant la ligne.
'------------------------------------
Sub Exemple()
Dim Message As String
Message = "Tu te compliques la vie."
'Au moment d'afficher ton message dans ta procédure
'tu écris :
StatusBarTest Message
End Sub
'------------------------------------
"Lionel" a écrit dans le message de news:
462fb25d$0$5105$
Bonsoir
Merci pour cette reponse mais j'ai une question certainement bete :
comment
j'utilise ca dans un cas reel
J'ai ma macro qui regulierment pendant son execution modifie le message
statusbar
Je reporte toutes ces lignes systematiquement?
Merci de m'eclairer car a priori je comprends pas le code alors si en plus
je sais pas ou le mettre ... Ca peut paraitre ridicule mais je peux pas
evoluer si j'ai pas certaines explications concernant les codes...
Merci Lionel
"Michel Pierron" a écrit dans le message de news:Bonjour Lionel;
Ce n'est pas prévu en natif; pour ce faire, il faut ruser.
Exemple, dans un module standard (police Times New Roman en rouge) :
Private Declare Function FindWindow& Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function FindWindowEx& Lib "user32" _
Alias "FindWindowExA" (ByVal hWnd1&, ByVal hWnd2& _
, ByVal lpsz1$, ByVal lpsz2$)
Private Declare Function GetDC& Lib "user32" (ByVal hWnd&)
' New color
Private Declare Function GetTextColor& Lib "gdi32" (ByVal hdc&)
Private Declare Function SetTextColor& Lib "gdi32" (ByVal hdc&, ByVal
crColor&)
' New police
Private Declare Function CreateFont& Lib "gdi32" Alias _
"CreateFontA" (ByVal nHeight&, ByVal nWidth& _
, ByVal nEscapement&, ByVal nOrientation&, ByVal fnWeight& _
, ByVal fdwItalic As Boolean, ByVal fdwUnderline As Boolean _
, ByVal fdwStrikeOut As Boolean, ByVal fdwCharSet& _
, ByVal fdwOutputPrecision&, ByVal fdwClipPrecision& _
, ByVal fdwQuality&, ByVal fdwPitchAndFamily&, ByVal lpszFace$)
Private Declare Function SelectObject& _
Lib "gdi32" (ByVal hdc&, ByVal hObject&)
Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject&)
Private Declare Function ReleaseDC& Lib "user32" (ByVal hWnd&, ByVal
hdc&)
Sub StatusBarTest()
Dim BarState As Boolean, hWnd&, hdc&, hFont&, hObj&, Color&
BarState = Application.DisplayStatusBar
Application.DisplayStatusBar = True
hWnd = FindWindow(vbNullString, Application.Caption)
hWnd = FindWindowEx(hWnd, ByVal 0&, "EXCEL4", vbNullString)
hdc = GetDC(hWnd)
Color = GetTextColor(hdc)
SetTextColor hdc, RGB(255, 0, 0)
hFont = CreateFont(-12, 0, 0, 0, 700, 1, 1, 0, 0, 0, 0, 0, 0, "Times New
Roman")
hObj = SelectObject(hdc, hFont)
Application.StatusBar = "This is my new police for StatusBar !"
MsgBox "How's that ?", 64
Application.StatusBar = False
SelectObject hdc, hObj
DeleteObject hFont
SetTextColor hdc, Color
ReleaseDC hWnd, hdc
Application.DisplayStatusBar = BarState
End Sub
"Lionel" a écrit dans le message de news:
462dd468$0$27404$bonjour
Est-il possible avec d'attribuer à l'expression
application.statusbar="xxxxxxx" une couleur?
je ne trouve rien qui fonctionne...
Merci
Lionel