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
GetKeyboardState kbOld
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
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
ShellExecute permet d'ouvrir le pense-bête.Tu peux m'expliquer le "{a64c3a50-b714-4e1f-a723-78db57a20a29}"
Où donc as-tu été le dénicher
(ou plutôt comment ? )
StikyNot_Note_Window = FindWindow("Sticky_Notes_Note_Window", "Pense-bête")
StikyNot_Note_Window = FindWindow(vbnullstring, "Pense-bête")
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)
Montexte_Window = FindWindowEx(CtrlNotifySink_Window, 0&, "{a64c3a50-b714-4e1f-a723-78db57a20a29}", vbNullString)
Au delà de mes espérancesEspérant avoir répondu à ta question.
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).tEST POUR AVOIR UN pOST6IT AUTOMATIQUE 0 PARTIR D4eXCEL;
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?
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 contenu de [A1] vient se rajouter dans un Post It déjà présent sur mon bureau!
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