Private Const WM_SETTEXT As Long = &HC& Private Const WM_CLOSE As Long = &H10& Private Const HTCAPTION As Long = 2& ' API : retourne le handle d'une sous-fenêtre depuis le handle d'une fenêtre parente Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long ' API : envoie un message à un handle (fenêtre ou system) Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal Msg As Long, wParam As Any, lParam As Any) As Long ' API : change le texte d'une fenêtre identifiée par son handle Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long ' Public Function SendTextToNotepad(ByVal sString As String, Optional ByVal vsTitle As Variant) As Boolean ' sString -> chaîne à transmettre à notepad ' vsTitle -> chaîne optionnelle pour personnaliser le caption de notepad ' retourne l'état de réussite ' *nécessite la fonction 'InstanceToWnd' disponible ici : http://www.codyx.org/snippet_recuperer-hwnd-handle-partir-pid-process-id_451.aspx#1462 ' lance notepad Dim lPID As Long lPID = Shell("notepad.exe", vbNormalFocus) DoEvents If lPID Then ' récupère le handle du notepad ouvert Dim nhWnd As Long nhWnd = InstanceToWnd(lPID) If nhWnd Then ' récupère le handle de la zone de texte du notepad Dim thWnd As Long thWnd = FindWindowEx(nhWnd, 0&, "Edit", vbNullString) If thWnd Then ' envoie le texte dans la zone de texte If SendMessage(thWnd, WM_SETTEXT, ByVal 0&, ByVal sString) Then ' réussite, on personalise le titre SendTextToNotepad = True If Not IsMissing(vsTitle) Then If VarType(vsTitle) = vbString Then Call SetWindowText(nhWnd, CStr(vsTitle)) End If Else ' échec de l'envoi, on ne laisse pas la fenêtre vide ouverte Call SendMessage(nhWnd, WM_CLOSE, ByVal HTCAPTION, ByVal vbNullString) End If End If End If End If End Function ' ------------------------ ' 3 EXEMPLES D'UTILISATION ' ------------------------ Private Sub Command1_Click() ' va ouvrir 3 "nouveaux documents notepad non-enregistrés", et y mettre : ' 1 : une chaine en paramètre (exemple VB6 et VBA) If Not SendTextToNotepad("je suis un texte" & vbCrLf & "multiligne non enregistré. " & _ "Une aide sur une méthode par exemple...", "'Developed By Exploreur'") Then _ MsgBox "Echec de l'envoi du texte vers notepad" ' 2 : le contenu du presse-papier, s'il y a (exemple VB6 uniquement) If Clipboard.GetFormat(vbCFText) Then SendTextToNotepad Clipboard.GetText ' 3 : le listing des DLL présentes dans SYSTEM32 (exemple VB6 et VBA nécessitant OS Win2000 ou supp) Dim asRet() As String, sPath As String sPath = Environ$("WINDIR") & "\system32\" 'http://www.codyx.org/snippet_lister-tous-fichiers-repertoire_198.aspx#688 If GetFilesPathFromDirectory(sPath, asRet, "*.dll") > -1 Then SendTextToNotepad Join(asRet, vbCrLf), "Listing des DLL" Erase asRet End Sub
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.