Sticky Notes (Post It)

Claudy

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
 
Trier par date Trier par votes
D

david84

XLDnaute Barbatruc
Re : Sticky Notes (Post It)

Bonjour,
histoire de faire avancer (un peu) le sujet, ci-joint une proposition non aboutie à base d'API :
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 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 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 FindWindowEx Lib "user32.dll" Alias "FindWindowExA" ( _
     ByVal hWnd1 As Long, _
     ByVal hwnd2 As Long, _
     ByVal lpsz1 As String, _
     ByVal lpsz2 As String) 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 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 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 FindWindowEx Lib "user32.dll" Alias "FindWindowExA" ( _
     ByVal hWnd1 As Long, _
     ByVal hwnd2 As Long, _
     ByVal lpsz1 As String, _
     ByVal lpsz2 As String) As Long
#End If
   
Const SW_NORMAL As Long = 1
Const WM_SETTEXT As Long = &HC

Sub Open_StikyNot()
Dim StikyNot_Window As Long, start_doc
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

Montexte = Worksheets("Feuil1").Range("A1").Text

StikyNot_Window = FindWindow(vbNullString, "Pense-bête")
start_doc = ShellExecute(StikyNot_Window, "open", "C:\Windows\System32\StikyNot.exe", 0, 0, SW_NORMAL)
If start_doc = 2 Or start_doc = 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.5: 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)

Call SendMessage(Montexte_Window, WM_SETTEXT, 0, Montexte)
End Sub

Chez moi j'arrive à faire apparaître le pense-bête et à y noter des caractères. Le problème est que ces caractères ne correspondent pas au texte noté dans la celle A1.
Pouvez-vous tester de votre côté et me dire :
- si le pense-bête apparaît
- si des caractères y sont ou non insérés
- si vous savez de quels caractères il s'agit
- si vous avez une idée sur le pourquoi de ce comportement.
A+
 

Pièces jointes

  • Ouvrir_pense_bete.xls
    47.5 KB · Affichages: 106
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Sticky Notes (Post It)

Bonjour à tous


david84
Apparemment cela fonctionne avec un script powershell (utilisation de sendkeys)
Donc peut-être voir de ce côte pour VBA
(autre suggestion: tester avec l' objet Clipboard et coller le texte dans la note)
 
Vote positif 0 Vote négatif
D

david84

XLDnaute Barbatruc
Re : Sticky Notes (Post It)

Staple1600 à dit:
Bonjour à tous


david84
Apparemment cela fonctionne avec un script powershell (utilisation de sendkeys)
Donc peut-être voir de ce côte pour VBA
(autre suggestion: tester avec l' objet Clipboard et coller le texte dans la note)
Cliquez pour agrandir...
Bonjour Jean-Marie,
je n'aime pas trop les SendKeys, néanmoins cela semble fonctionner comme cela :
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 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
#Else 'si autre version
  Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
     ByVal lpClassName As String, _
     ByVal lpWindowName As String) 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
#End If
   
Const SW_NORMAL As Long = 1

'cocher Microsoft Forms x.x Object Library
Sub Open_StikyNot2()
Dim StikyNot_Window As Long, start_doc
Dim StikyNot_Note_Window As Long
Dim Montexte As String
Dim oDat As DataObject

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

StikyNot_Window = FindWindow(vbNullString, "Pense-bête")
start_doc = ShellExecute(StikyNot_Window, "open", "C:\Windows\System32\StikyNot.exe", 0, 0, SW_NORMAL)
If start_doc = 2 Or start_doc = 3 Then Exit Sub
Do
  DoEvents
  StikyNot_Note_Window = FindWindow("Sticky_Notes_Note_Window", "Pense-bête")
Loop Until StikyNot_Note_Window > 2
SendKeys "^v"
SendKeys "{NUMLOCK}"
Set oDat = Nothing
End Sub
Ceci-dit, concernant mon 1er code peux-tu me dire:
- si le pense-bête apparaît
- si des caractères y sont ou non insérés
- si tu sais de quels caractères il s'agit
- si tu as une idée sur le pourquoi de ce comportement.
A+
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Sticky Notes (Post It)

Re


david84
J'aimerai t'en dire plus mais après tests de tes deux procs (W764b+XL 2013 32b), rien ne s'affiche.
(stikynot.exe ne s'ouvre pas)
Quel est ton OS ?
PS: Je crois que cela est peut-être lié à l'UAC sous Seven, non ?
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Sticky Notes (Post It)

Re

david84
Cela fonctionne sur mon PC (Seven 64bits)
(pour ce qui est d'ouvrir stikynot.exe)
Code: 
Private Declare Function Wow64DisableWow64FsRedirection Lib "kernel32.dll" (ByVal OldValue As Long) As Boolean
Private Declare Function Wow64RevertWow64FsRedirection 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.dll" (ByVal IsEnable As Boolean) As Boolean

Code: 
Sub RunYourProgram()
Dim RetVal As Long
On Error Resume Next
Dim tmp As Long
RetVal = Wow64DisableWow64FsRedirection(tmp)
RetVal = ShellExecute(0, "open", "stikynot", "", "", SW_SHOWMAXIMIZED)
Wow64EnableWow64FsRedirection (True)
End Sub
Pour les détails voir ici
(PS: problème référencé avec Seven. Ouf je ne suis donc pas le seul ;) )
 
Vote positif 0 Vote négatif
D

david84

XLDnaute Barbatruc
Re : Sticky Notes (Post It)

Effectivement cela ne fonctionne pas sur mon autre ordinateur...je regarderai plus attentivement plus tard.
En attendant, en repartant du code que tu as trouvé est-ce que cela fonctionne chez toi (chez moi c'est ok sur les 2 ordinateurs testés) :
Code: 
Option Explicit
#If VBA7 And Win64 Then
  Private Declare PtrSafe Function Wow64DisableWow64FsRedirection Lib "kernel32.dll" ( _
  ByVal OldValue As Long) As Boolean
  Private Declare PtrSafe Function Wow64RevertWow64FsRedirection 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.dll" ( _
  ByVal IsEnable As Boolean) As Boolean
#Else
  Private Declare Function Wow64DisableWow64FsRedirection Lib "kernel32.dll" ( _
  ByVal OldValue As Long) As Boolean
  Private Declare Function Wow64RevertWow64FsRedirection 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.dll" ( _
  ByVal IsEnable As Boolean) As Boolean
#End If
Const SW_NORMAL As Long = 1

'cocher Microsoft Forms x.x Object Library
Sub RunYourProgram()
Dim RetVal As Long
Dim Montexte As String
Dim oDat As DataObject
Dim t As Single
Dim tmp As Long
Montexte = Worksheets("Feuil1").Range("A1").Text 'ne pas oublier de renseigner la cellule A1
Set oDat = New DataObject
oDat.SetText Montexte
oDat.PutInClipboard

'On Error Resume Next
RetVal = Wow64DisableWow64FsRedirection(tmp)
RetVal = ShellExecute(0, "open", "stikynot", "", "", SW_NORMAL)
Wow64EnableWow64FsRedirection (True)
t = Timer
Do While Timer < t + 0.5: DoEvents: Loop
SendKeys "^v"
SendKeys "{NUMLOCK}"
Set oDat = Nothing
End Sub
A+
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Sticky Notes (Post It)

Re

david84
Test Ok en passant par le clipboard ;)
Merci à toi et à Claudy.
Ce fil m'aura permis de découvrir cette bestiole
Wow64DisableWow64FsRedirection

PS: Merci également à "Mister Shasur", auteur du code cité plus bas.
(voir mon lien dans le message #12)
 
Dernière édition:
Vote positif 0 Vote négatif
D

david84

XLDnaute Barbatruc
Re : Sticky Notes (Post It)

Après avoir regardé ces API j'ai l'impression que :
Code: 
Private Declare Function Wow64RevertWow64FsRedirection Lib "kernel32.dll" (ByVal OldValue As Long) As Boolean
n'est pas utile dans ce contexte, pas plus que :
Code: 
Private Declare Function IsWow64Process Lib "kernel32.dll" ( _
   ByVal IsEnable As Boolean) As Boolean
qui, de plus me semble incomplète (pour moi il manque un argument) et non utilisable sans l'utilisation d'une API permettant de ramener préalablement le pointeur du process utilisé (GetCurrentProcess par exemple).

J'ai préféré utiliser une compilation conditionnelle dans "RunYourProgram" pour distinguer le cas 64 bits/32 bits.

En fait les API utilisées dans le dernier code ne sont utiles que dans un environnement 32 bits.
Si l'on veut un code susceptible de fonctionner dans un environnement 32 ou 64 bits, on peut tester ceci :
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
#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
#End If

Const SW_NORMAL As Long = 1

Sub RunYourProgram()
Dim RetVal As Long
Dim Montexte As String
Dim oDat As DataObject
Dim t As Single
Dim tmp As Long
Montexte = Worksheets("Feuil1").Range("A1").Text
Set oDat = New DataObject
oDat.SetText Montexte
oDat.PutInClipboard

#If Win64 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"
SendKeys "{NUMLOCK}"
Set oDat = Nothing
End Sub
Ce qui me surprend c'est que la compilation conditionnelle doit être utilisée même pour l'éventuel environnement 64 bits (#If Win64 ) et ce même si ces API ne sont pas utilisées dans cet environnement
Code: 
#If Win64 Then
  RetVal = ShellExecute(0, "open", "stikynot", "", "", SW_NORMAL)

Maintenant, il est aussi possible d'utiliser l'API IsWow64Process en la combinant avec GetCurrentProcess pour savoir si l'on est dans un environnement 32 ou 64 bits :
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
#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
#End If
Const SW_NORMAL As Long = 1

'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
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"
SendKeys "{NUMLOCK}"
Set oDat = Nothing
End Sub
A+
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

F
  • Résolu(e)
XL 2019 Création Post-it
Réponses
2
Affichages
200
farid
F
M
  • Résolu(e)
Microsoft 365 Calculer nombre de note avec "texte"
2
Réponses
17
Affichages
287
DJunqueira
D
T
  • Question
XL pour MAC Calcul de notes.
Réponses
5
Affichages
163
Katido
K
F
  • Question
XL 2016 VBA repérage de chaines de caractères dans colonne
Réponses
9
Affichages
225
finarobert
F
P
  • Question
Microsoft 365 Enregistrement des notes prises dans un fichier
2 3 4
Réponses
56
Affichages
1 K
pelerin65
P
Y
  • Question
XL 2019 exploitation de données
Réponses
3
Affichages
251
JHA
J
A
  • Question
XL 2016 Ancrer/figer un userform sur une page excel
Réponses
7
Affichages
501
sylvanu
sylvanu
Claudy
  • Question
Microsoft 365 Liste validation grace aux premières lettres
Réponses
3
Affichages
185
job75
job75
D
  • Question
XL 2016 Utiliser un équivalent de INDIRECT sur des classeurs fermés
Réponses
8
Affichages
333
job75
job75
B
  • Question
Autres Renvoyer un nom dans une cellule en fonction d'une résultat dans une autre
Réponses
8
Affichages
323
BabyDolphin30
B

Membres actuellement en ligne

18 membres et 87 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 500
Messages
2 089 013
Membres
104 004
dernier inscrit
mista