Const NPMsg As String = "Notepad ID = "
Private Const GW_CHILD = 5
Private Const WM_SETTEXT = &HC
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const WM_CLOSE = &H10
Private Const EM_REPLACESEL = &HC2
Private Const EM_SETSEL = &HB1
Private Const EM_SETMODIFY = &HB9
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" _
(ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String) As Long
Private Declare Function GetWindow Lib "user32" _
(ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Function SendMessageStr Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As Any) As Long
Private Declare Function MoveWindow Lib "user32" _
(ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, _
ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
''To update the cell contents from Notepad.
Public Function GetNote(Ra As Range, hWnd As Long) As Boolean
GetNote = False
If hWnd = 0 Then Exit Function
Ra.FormulaLocal = ReadNotepad(hWnd)
GetNote = True
End Function
'Passing the cell contents in Notepad.
'HWnd new start time is omitted, it returns the hWnd.
Public Function PutNote(Ra As Range, Optional hWnd As Long = 0) As Long
Dim strText As String
If hWnd = 0 Then hWnd = OpenNotepad()
PutNote = hWnd
If hWnd = 0 Then Exit Function
strText = Ra.FormulaLocal
strText = Replace(strText, vbLf, vbCrLf)
WriteNotepad hWnd, strText
End Function
'HWnd unsaved to clear the flag specified in Notepad.
Public Function SetSavedNotepad(hWnd As Long) As Long
Dim i As Long
i = GetWindow(hWnd, GW_CHILD)
SendMessage i, EM_SETMODIFY, 0, 0
SetSavedNotepad = i
End Function
'HWnd Close Notepad specified.
Public Sub CloseNotepad(hWnd As Long)
SetSavedNotepad hWnd
SendMessage hWnd, WM_CLOSE, 0, 0
End Sub
'Start a new notepad, hWnd returned.
Public Function OpenNotepad(Optional iWindowState As Long = vbNormalFocus) As Long
Dim hWnd As Long
Dim ProcID As Long, ThreadID As Long
Dim i As Long, j As Long, k As Long
On Error GoTo Err1
i = Shell("notepad.exe", iWindowState)
If i = 0 Then GoTo Err1
hWnd = 0
Do
'hWnd = FindWindowEx(0, hWnd, "Notepad", "?? - ???")
hWnd = FindWindowEx(0, hWnd, "Notepad", vbNullString)
If hWnd = 0 Then GoTo Err1
ThreadID = GetWindowThreadProcessId(hWnd, ProcID)
Loop Until i = ProcID
i = SetWindowText(hWnd, NPMsg & ProcID)
'MoveWindow hWnd, 0, 50, 300, 200, 1
'Z-order if you change the SetWindowPos
SetWindowPos hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
OpenNotepad = hWnd
Exit Function
Err1:
MsgBox "Error", , NPMsg
OpenNotepad = 0
End Function
'HWnd content specified in Notepad, replace the specified character.
Public Function WriteNotepad(hWnd As Long, strTextAll As String) As Boolean
Dim i As Long
i = GetWindow(hWnd, GW_CHILD)
WriteNotepad = (0 <> SendMessageStr(i, WM_SETTEXT, 0, strTextAll))
End Function
'HWnd specified in Notepad, add the specified character. ????? With a new line.
'IPos = 0: the current cursor position
'-1: Top
'1: last
Public Function WriteLineNotepad(hWnd As Long, strText As String, Optional iPos As Long = 0) As Boolean
WriteLineNotepad = WriteTextNotepad(hWnd, strText & vbNewLine, iPos)
End Function
'HWnd specified in Notepad, add the specified character. No newline.
'IPos = 0: the current cursor position
'-1: Top
'1: last
Public Function WriteTextNotepad(hWnd As Long, strText As String, _
Optional iPos As Long = 0) As Boolean
Dim i As Long
i = GetWindow(hWnd, GW_CHILD)
Select Case iPos
Case -1
SendMessage i, EM_SETSEL, 0, 0
Case 1
SendMessage i, EM_SETSEL, 0, -1 'select all
SendMessage i, EM_SETSEL, -1, 0 'Deselect (move the cursor to the end of the selected area)
End Select
WriteTextNotepad = (0 <> SendMessageStr(i, EM_REPLACESEL, 0, strText))
End Function
'HWnd specified the contents of the Notepad, you get a letter.
Public Function ReadNotepad(hWnd As Long) As String
Dim i As Long
Dim j As Long
Dim x As String
i = GetWindow(hWnd, GW_CHILD)
j = 1 + SendMessage(i, WM_GETTEXTLENGTH, 0, 0)
x = String(j, Chr(0))
SendMessageStr i, WM_GETTEXT, j, x
ReadNotepad = x
End Function
