Sticky Notes (Post It)

Claudy

XLDnaute Accro
Bonjour,
est il possible d'insèrer un Post It (Stycky Notes) sur mon bureau avec le contenu de la cellule "A1" ?
Merci d'avance,
Claudy
 

david84

XLDnaute Barbatruc
Re : Sticky Notes (Post It)

Bonjour,
l'instruction Senkeys est capricieuse et peut entraîner des problèmes, notamment sur les touches de verrouillage (verrouillage du pavé numérique, verrouillage de la touche majuscule et verrouillage de la touche de défilement).
Pour pallier ce problème j'ai inclus dans le code ci-dessous une API supplémentaire GetKeyboardState.

Code:
Option Explicit

#If Win64 Then
  Private Declare PtrSafe Function Wow64DisableWow64FsRedirection Lib "kernel32.dll" ( _
  ByVal OldValue As Long) As Boolean
  Private Declare PtrSafe Function Wow64EnableWow64FsRedirection Lib "kernel32.dll" ( _
  ByVal IsEnable As Boolean) As Boolean
  Private Declare PtrSafe Function IsWow64Process Lib "kernel32" ( _
  ByVal hProcess As Long, ByRef Wow64Process As Long) As Long
  Private Declare PtrSafe Function GetCurrentProcess Lib "kernel32" () As Long
  Private Declare PtrSafe Function GetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
#Else
  Private Declare Function Wow64DisableWow64FsRedirection Lib "kernel32.dll" ( _
  ByVal OldValue As Long) As Boolean
  Private Declare Function Wow64EnableWow64FsRedirection Lib "kernel32.dll" ( _
  ByVal IsEnable As Boolean) As Boolean
  Private Declare Function IsWow64Process Lib "kernel32" ( _
  ByVal hProcess As Long, ByRef Wow64Process As Long) As Long
  Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
  Private Declare Function GetKeyboardState Lib "user32" (kbArray As KeyboardBytes) As Long
#End If

Const SW_NORMAL As Long = 1
Const VK_CAPITAL = &H14
Const VK_NUMLOCK = &H90
Const VK_SCROLL = &H91
Private Type KeyboardBytes
     kbByte(0 To 255) As Byte
End Type

'cocher Microsoft Forms x.x Object Library
Sub RunYourProgram2()
Dim RetVal As Long
Dim Montexte As String
Dim oDat As DataObject
Dim t As Single
Dim tmp As Long
Dim Ret As Long
Dim ToucheClavier As Long
Dim kbArray As KeyboardBytes
Dim kbOld As KeyboardBytes

GetKeyboardState kbOld
Montexte = Worksheets("Feuil1").Range("A1").Text
Set oDat = New DataObject
oDat.SetText Montexte
oDat.PutInClipboard
IsWow64Process GetCurrentProcess, Ret
If Ret = 0 Then
  RetVal = ShellExecute(0, "open", "stikynot", "", "", SW_NORMAL)
Else
  RetVal = Wow64DisableWow64FsRedirection(tmp)
  RetVal = ShellExecute(0, "open", "stikynot", "", "", SW_NORMAL)
  Wow64EnableWow64FsRedirection (True)
End If
If RetVal = 2 Or RetVal = 3 Then Exit Sub
t = Timer
Do While Timer < t + 0.3: DoEvents: Loop
SendKeys "^v", True

ToucheClavier = kbOld.kbByte(VK_CAPITAL) 'touche majuscule
If ToucheClavier <> kbArray.kbByte(VK_CAPITAL) Then SendKeys "{CAPSLOCK}", True
ToucheClavier = kbOld.kbByte(VK_SCROLL) 'touche de défilement
If ToucheClavier <> kbArray.kbByte(VK_SCROLL) Then SendKeys "{SCROLLLOCK}", True
ToucheClavier = kbOld.kbByte(VK_NUMLOCK) 'touche pavé numérique
If ToucheClavier <> kbArray.kbByte(VK_NUMLOCK) Then SendKeys "{NUMLOCK}", True

Set oDat = Nothing
End Sub

Le procédé est le suivant :
- constitution d'un array afin d'enregistrer l'état des touches du clavier en début de code
Code:
GetKeyboardState kbOld
- comparaison après avoir copié le texte dans le pense-bête de l'état des touches de verrouillage par rapport à leur état initial : si l'état de la touche (actif/inactif) a été modifié on la ramène à l'état initial via un SendKeys
Code:
ToucheClavier = kbOld.kbByte(VK_CAPITAL) 'touche majuscule
If ToucheClavier <> kbArray.kbByte(VK_CAPITAL) Then SendKeys "{CAPSLOCK}", True
ToucheClavier = kbOld.kbByte(VK_SCROLL) 'touche de défilement
If ToucheClavier <> kbArray.kbByte(VK_SCROLL) Then SendKeys "{SCROLLLOCK}", True
ToucheClavier = kbOld.kbByte(VK_NUMLOCK) 'touche pavé numérique
If ToucheClavier <> kbArray.kbByte(VK_NUMLOCK) Then SendKeys "{NUMLOCK}", True

En résumé, ce traitement doit permettre de conserver l'état initial de ces 3 touches de verrouillage avant le lancement de la procédure.

Le code de mon message précédent comportant l'utilisation d'une compilation conditionnelle à la place de l'utilisation de IsWow64Process (permettant de vérifier si l'on se trouve dans un environnement 32 ou 64 bits) peut être adapté de la même manière.
A+
 

Staple1600

XLDnaute Barbatruc
Re : Sticky Notes (Post It)

Bonjour à tous

david84
Du bel ouvrage que voilà.
Mais je suis en total désaccord sur un point précis.
Vous faites fi du repos dominical.
Faut-t-il que vous soyez "fou d'amour" pour vous macros, pour vous mettre à la tâche avec une telle persévérance en plein week-end !
Déjà que vous avez une forte inclinaison pour le pattern, (je parle même pas de votre marotte que laisse transparaître votre signature).
Si en plus, maintenant vous auscultez votre clavier sous toutes les coutures... mais, mon bon ami, quand trouvez-vous le temps de vous reposer !
Ceci dit cela me fait bien plaisir de lire ce genre de code le dimanche matin en épluchant mes radis
(mais j'ose espérer que cela ne sera au détriment de votre bien-être)
 

david84

XLDnaute Barbatruc
Re : Sticky Notes (Post It)

Et fin (à moins que)...si l'on ne veut pas utiliser l'instruction SendKeys, c'est plus compliqué mais c'est possible :
Code:
Option Explicit
#If Win64 And VBA7 Then 'si version Excel 2010 64 bits
  Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
    ByVal lpClassName As String, ByVal lpWindowName As String) As Long
     
  Declare PtrSafe Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" ( _
    ByVal hWnd1 As Long, ByVal hwnd2 As Long, ByVal lpsz1 As String, _
    ByVal lpsz2 As String) As Long
     
  Declare PtrSafe Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
    ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
    ByRef lParam As Any) As Long
     
  Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
    ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long
     
  Declare PtrSafe Function Wow64DisableWow64FsRedirection Lib "kernel32.dll" ( _
    ByVal OldValue As Long) As Boolean
  
  Declare PtrSafe Function Wow64EnableWow64FsRedirection Lib "kernel32.dll" ( _
    ByVal IsEnable As Boolean) As Boolean
    
  Private Declare PtrSafe Function IsWow64Process Lib "kernel32" ( _
    ByVal hProcess As Long, ByRef Wow64Process As Long) As Long
  
  Private Declare PtrSafe Function GetCurrentProcess Lib "kernel32" () As Long
  
#Else 'si autre version
  Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
     ByVal lpClassName As String, ByVal lpWindowName As String) As Long
     
  Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" ( _
    ByVal hWnd1 As Long, ByVal hwnd2 As Long, ByVal lpsz1 As String, _
    ByVal lpsz2 As String) As Long
     
  Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
    ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
    ByRef lParam As Any) As Long
     
  Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
    ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long
     
  Declare Function Wow64DisableWow64FsRedirection Lib "kernel32.dll" ( _
    ByVal OldValue As Long) As Boolean
  
  Declare Function Wow64EnableWow64FsRedirection Lib "kernel32.dll" ( _
    ByVal IsEnable As Boolean) As Boolean
  
  Private Declare Function IsWow64Process Lib "kernel32" ( _
    ByVal hProcess As Long, ByRef Wow64Process As Long) As Long
  
  Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
#End If
   
Const SW_NORMAL As Long = 1
Const WM_PASTE = &H302

'cocher Microsoft Forms x.x Object Library
Sub Open_StikyNot()
Dim StikyNot_Note_Window As Long
Dim DirectUIHWND_Window As Long
Dim CtrlNotifySink_Window As Long
Dim Montexte_Window As Long
Dim Montexte As String
Dim t As Single
Dim oDat As DataObject
Dim RetVal As Long
Dim Ret As Long
Dim tmp As Long

Montexte = Worksheets("Feuil1").Range("A1").Text
Set oDat = New DataObject
oDat.SetText Montexte
oDat.PutInClipboard

IsWow64Process GetCurrentProcess, Ret
If Ret = 0 Then
  RetVal = ShellExecute(0, "open", "stikynot", "", "", SW_NORMAL)
Else
  RetVal = Wow64DisableWow64FsRedirection(tmp)
  RetVal = ShellExecute(0, "open", "stikynot", "", "", SW_NORMAL)
  Wow64EnableWow64FsRedirection (True)
End If
If RetVal = 2 Or RetVal = 3 Then Exit Sub
Do
  DoEvents
  StikyNot_Note_Window = FindWindow("Sticky_Notes_Note_Window", "Pense-bête")
Loop Until StikyNot_Note_Window > 2

t = Timer
Do While Timer < t + 0.3: DoEvents: Loop

DirectUIHWND_Window = FindWindowEx(StikyNot_Note_Window, 0&, "DirectUIHWND", vbNullString)
CtrlNotifySink_Window = FindWindowEx(DirectUIHWND_Window, 0&, "CtrlNotifySink", vbNullString)
Montexte_Window = FindWindowEx(CtrlNotifySink_Window, 0&, "{a64c3a50-b714-4e1f-a723-78db57a20a29}", vbNullString)

SendMessage Montexte_Window, WM_PASTE, 0, ByVal 0&
End Sub
Testé sur 2 ordinateurs :
- Windows7 et Excel 2010 64 bits
- Windows7 et Excel 2007
A+
 

Staple1600

XLDnaute Barbatruc
Re : Sticky Notes (Post It)

Re

david84
Pour ma gouverne (même si je contreviens à mon précepte du repos dominical)
Montexte_Window = FindWindowEx(CtrlNotifySink_Window, 0&, "{a64c3a50-b714-4e1f-a723-78db57a20a29}", vbNullString)

Tu peux m'expliquer le
"{a64c3a50-b714-4e1f-a723-78db57a20a29}"
Où donc as-tu été le dénicher
:confused::confused:
(ou plutôt comment ? )

Serais-tu un gourou du CLSID ? ;)

PS: test OK (W764bits + XL 2013 32 bits)
 
Dernière édition:

david84

XLDnaute Barbatruc
Re : Sticky Notes (Post It)

Tu peux m'expliquer le "{a64c3a50-b714-4e1f-a723-78db57a20a29}"
Où donc as-tu été le dénicher
(ou plutôt comment ? )
ShellExecute permet d'ouvrir le pense-bête.
Le but de la manœuvre est ensuite d'accéder à la fenêtre de saisie textuelle. Pour cela on utilise dans un premier temps l'API FindWindow afin de récupérer le pointeur de la fenêtre générale du pense-bête
Code:
StikyNot_Note_Window = FindWindow("Sticky_Notes_Note_Window", "Pense-bête")
J'aurais pu écrire
Code:
StikyNot_Note_Window = FindWindow(vbnullstring, "Pense-bête")
si je ne connaissais pas le nom de la classe de cette fenêtre et cela fonctionnerait (moyennant quelques ajustements) mais comme je connais son nom -Sticky_Notes_Note_Window- (j'explique plus loin comment), donc je l'utilise.

Une fois le pointeur de cette fenêtre générale identifié je dois descendre dans l'arborescence du pense-bête pour arriver jusqu'à la fenêtre de saisie afin d'y coller le contenu du clipboard (je peux bien sûr me passer de cette procédure en utilisant un SendKeys comme démontré dans les codes précédents).
Pour cela j'utilise l'API FindWindowEx qui permet de récupérer le pointeur de la fenêtre enfant à partir de l'indication de la fenêtre indiquée.
C'est la partie
Code:
DirectUIHWND_Window = FindWindowEx(StikyNot_Note_Window, 0&, "DirectUIHWND", vbNullString)
CtrlNotifySink_Window = FindWindowEx(DirectUIHWND_Window, 0&, "CtrlNotifySink", vbNullString)
Montexte_Window = FindWindowEx(CtrlNotifySink_Window, 0&, "{a64c3a50-b714-4e1f-a723-78db57a20a29}", vbNullString)
Tu remarqueras que le 1er argument de la fonction correspond au pointeur de la fenêtre traitée à l'étape précédente.

Une fois le pointeur de la fenêtre de saisie identifié j'utilise l'API SendMessage pour coller le contenu du clipboard.

Pour répondre directement à ta question :
Code:
Montexte_Window = FindWindowEx(CtrlNotifySink_Window, 0&, "{a64c3a50-b714-4e1f-a723-78db57a20a29}", vbNullString)
"{a64c3a50-b714-4e1f-a723-78db57a20a29}" correspond au nom de la classe de la fenêtre que je cherche à récupérer car si je n'ai pas ce paramètre ma fonction échouera puisque cette fenêtre ne comporte pas de nom (c'est pourquoi le 4ème argument de la fonction est vbNullString).

Pour arriver à récupérer le nom de la classe j'utilise un logiciel qui répertorie l'ensemble des fenêtres actives de l'ordinateur. Tu as plusieurs logiciels qui te permettent de faire cela. Personnellement j'utilise WinSpy++ (tu as également Spy++ qui est excellent mais il te faut alors télécharger l'ensemble du package Visual Studio, et encore cela dépend de la version).

Espérant avoir répondu à ta question.
A+
 
Dernière édition:

MJ13

XLDnaute Barbatruc
Re : Sticky Notes (Post It)

Bonjour à tous


Merci David :) et Jean-Marie :) pour tous ces jolis codes :eek:.

Sinon, j'ai fait cette version à tester. Il faudra peut être changer le chemin du logiciel selon votre config.
 

Pièces jointes

  • Post_It_MJ.xlsm
    25.7 KB · Affichages: 84

david84

XLDnaute Barbatruc
Re : Sticky Notes (Post It)

Bonjour Michel,
je note un problème lorsque je verrouille la touche Maj avant de lancer la macro.
tEST POUR AVOIR UN pOST6IT AUTOMATIQUE 0 PARTIR D4eXCEL;
C'est la raison pour laquelle j'ai préféré placer le texte en A1 dans le presse-papier plutôt que d'inclure ce texte dans un SendKeys (mais bien sûr il y a d'autres façons de procéder).

Si je lance une nouvelle fois la macro après avoir déverrouillé la touche Maj celle-ci se verrouille durant la procédure et le résultat obtenu est le même.
A+
 

MJ13

XLDnaute Barbatruc
Re : Sticky Notes (Post It)

Re

Merci pour vos tests :).

Sur des configs en 32 bits Win 7 et Win 8 et Office 2007 et 2013 e 32 bits, je n'ai pas de problèmes :).

Et ma touche majuscule, je ne la verrouille jamais (encore un autre problème de clavier que je déplore :().
 

Claudy

XLDnaute Accro
Re : Sticky Notes (Post It)

Heu ben merci à tous...
pensais pas que ça allait engendrer autant de travail!
Michel , ta solution me convient bien, mais si je peux me permettre:
le contenu de [A1] vient se rajouter dans un Post It déjà présent sur mon bureau!
Comment générer un nouveau Post It et au mieux dans une autre couleur?
Merci et bonne journée,
Claudy
 

MJ13

XLDnaute Barbatruc
Re : Sticky Notes (Post It)

Bonjour à tous

Heu ben merci à tous...
pensais pas que ça allait engendrer autant de travail!
Michel , ta solution me convient bien, mais si je peux me permettre:
le contenu de [A1] vient se rajouter dans un Post It déjà présent sur mon bureau!
Comment générer un nouveau Post It et au mieux dans une autre couleur?

Le travail vient en fait des différentes versions d'Excel :(.

Sinon pour avoir 2 postIt, tu peux tester ce code qui n'est pas optimisé du tout car il te le crée à priori. Il y a sûrement d'autres moyens d'y arriver, mais là, ce n'est plus mon domaine :eek:.

Code VBA:
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Notes()
cancel = True
NumLock_On
Texte = [a1].Value
'Adapter le chemin à Stikynot.exe (faire une recherche dans C:\Windows)
Shell ("C:\Windows\System32\StikyNot.exe"), vbMaximizedFocus
Sleep 100
Application.SendKeys (Chr(10) & Texte), True
Sleep 100
Application.SendKeys ("^n"), True
NumLock_On
End Sub
 

david84

XLDnaute Barbatruc
Re : Sticky Notes (Post It)

le contenu de [A1] vient se rajouter dans un Post It déjà présent sur mon bureau!
Cette version un peu allégée en API (2 API en moins) n'utilise ni le clipboard pour stocker le texte de A1 ni les SendKeys pour le copier dans le pense bête.
Le code n'engendre pas le problème que tu as relevé et semble fonctionner avec les différentes versions d'Excel et dans les environnements 32 et 64 bits (à vérifier toutefois sur une version Excel 2013 64 bits).
Code:
Option Explicit
#If Win64 And VBA7 Then 'si version Excel 2010 64 bits
  Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
    ByVal lpClassName As String, ByVal lpWindowName As String) As Long
     
  Declare PtrSafe Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" ( _
    ByVal hWnd1 As Long, ByVal hwnd2 As Long, ByVal lpsz1 As String, _
    ByVal lpsz2 As String) As Long
     
  Declare PtrSafe Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
    ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
    ByRef lParam As Any) As Long
     
  Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
    ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long
     
  Declare PtrSafe Function Wow64DisableWow64FsRedirection Lib "kernel32.dll" ( _
    ByVal OldValue As Long) As Boolean
  
  Declare PtrSafe Function Wow64EnableWow64FsRedirection Lib "kernel32.dll" ( _
    ByVal IsEnable As Boolean) As Boolean
#Else 'si autre version
  Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
     ByVal lpClassName As String, ByVal lpWindowName As String) As Long
     
  Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" ( _
    ByVal hWnd1 As Long, ByVal hwnd2 As Long, ByVal lpsz1 As String, _
    ByVal lpsz2 As String) As Long
     
  Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
    ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
    ByRef lParam As Any) As Long
     
  Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
    ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long
     
  Declare Function Wow64DisableWow64FsRedirection Lib "kernel32.dll" ( _
    ByVal OldValue As Long) As Boolean
  
  Declare Function Wow64EnableWow64FsRedirection Lib "kernel32.dll" ( _
    ByVal IsEnable As Boolean) As Boolean
#End If
   
Const SW_NORMAL As Long = 1
Const WM_SETTEXT As Long = &HC

Sub Open_StikyNot()
Dim StikyNot_Note_Window As Long
Dim DirectUIHWND_Window As Long
Dim CtrlNotifySink_Window As Long
Dim Montexte_Window As Long
Dim Montexte As String
Dim t As Single
Dim RetVal As Long
Dim tmp As Long

Montexte = Worksheets("Feuil1").Range("A1").Text
RetVal = Wow64DisableWow64FsRedirection(tmp)
RetVal = ShellExecute(0, "open", "stikynot", "", "", SW_NORMAL)
Wow64EnableWow64FsRedirection (True)
If RetVal = 2 Or RetVal = 3 Then Exit Sub
Do
  DoEvents
  StikyNot_Note_Window = FindWindow("Sticky_Notes_Note_Window", "Pense-bête")
Loop Until StikyNot_Note_Window > 2

t = Timer
Do While Timer < t + 0.3: DoEvents: Loop

DirectUIHWND_Window = FindWindowEx(StikyNot_Note_Window, 0&, "DirectUIHWND", vbNullString)
CtrlNotifySink_Window = FindWindowEx(DirectUIHWND_Window, 0&, "CtrlNotifySink", vbNullString)
Montexte_Window = FindWindowEx(CtrlNotifySink_Window, 0&, "{a64c3a50-b714-4e1f-a723-78db57a20a29}", vbNullString)

SendMessage Montexte_Window, WM_SETTEXT, 0, ByVal Montexte
End Sub
A+
 
Dernière édition:

Discussions similaires

Réponses
2
Affichages
200
Réponses
5
Affichages
163

Statistiques des forums

Discussions
312 502
Messages
2 089 046
Membres
104 010
dernier inscrit
Freba