| |
▼pon さん：
試してみて下さい。
Option Explicit
Private Declare Function FindWindow Lib "user32.dll" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32.dll" _
Alias "FindWindowExA" _
(ByVal hwndParent As Long, _
ByVal hwndChildAfter As Long, _
ByVal lpszClass As String, _
ByVal lpszWindow As String) As Long
Private Const WM_COMMAND = &H111
Private Const WM_CLOSE = &H10
Private Const WM_SETTEXT = &HC
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const BN_CLICKED = 0
Private Const BM_CLICK = &HF5&
Private Declare Function PostMessage Lib "User32" _
Alias "PostMessageA" _
(ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Declare Function SendMessage Lib "user32.dll" _
Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function SendDlgItemMessageA Lib "User32" _
(ByVal hDlg As Long, _
ByVal nIDDlgItem As Long, _
ByVal Msg As Long, _
ByRef wParam As Any, _
ByRef lParam As Any) As Long
Private Const HWND_TOPMOST As Long = -1&
Private Const SWP_NOSIZE As Long = &H1&
Private Const SWP_NOMOVE As Long = &H2&
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
Private hWnd As Long ' hWnd
Private hEditWnd As Long ' Edit
Private Const dBtn As Long = &H5A& '/ 5A
Private Const xBtn As Long = &H5B& '* 5B
Private Const aBtn As Long = &H5C& '+ 5C
Private Const sBtn As Long = &H5D& '- 5D
Private Const eBtn As Long = &H70& '= 70
Private Const cBtn As Long = &H51& 'C 51
Private dHwnd As Long '/
Private xHwnd As Long '*
Private aHwnd As Long '+
Private sHwnd As Long '-
Private eHwnd As Long '=
Private tHwnd As Long
Private Const btn0 As Long = &H7C&
Private Const btn1 As Long = &H7D&
Private Const btn2 As Long = &H7E&
Private Const btn3 As Long = &H7F&
Private Const btn4 As Long = &H80&
Private Const btn5 As Long = &H81&
Private Const btn6 As Long = &H82&
Private Const btn7 As Long = &H83&
Private Const btn8 As Long = &H84&
Private Const btn9 As Long = &H85&
Private hWnd0 As Long
Private hWnd1 As Long
Private hWnd2 As Long
Private hWnd3 As Long
Private hWnd4 As Long
Private hWnd5 As Long
Private hWnd6 As Long
Private hWnd7 As Long
Private hWnd8 As Long
Private hWnd9 As Long
' 電卓の起動
Sub CalucStart()
Dim lngRtn As Long
Dim strA As String
' 電卓
Application.ActivateMicrosoftApp Index:=0
' 電卓の hWnd
hWnd = FindWindowEx(0&, 0&, "SciCalc", "電卓")
' 最前面に表示
SetWindowPos hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE
End Sub
Function CalucProc(str1 As String, str2 As String, pType As String) As String
Dim lngRtn As Long
Dim ary1 As Variant
Dim ary2 As Variant
Dim i As Long
Dim mType As Long
Dim strBuff As String * 255
If Not (IsNumeric(str1) And IsNumeric(str2)) Then
MsgBox "数値が入力されていません。"
Exit Function
End If
' 電卓の hWnd
hWnd = FindWindowEx(0&, 0&, "SciCalc", "電卓")
If hWnd = 0 Then Call CalucStart
' [関数電卓]のメニューID = 304
lngRtn = PostMessage(hWnd, WM_COMMAND, 304, 0)
' 電卓内のEdit Handle
hEditWnd = FindWindowEx(hWnd, 0&, "Edit", vbNullString)
'十進数
tHwnd = FindWindowEx(hWnd, 0&, "Button", "10 進")
lngRtn = SendMessage(tHwnd, BM_CLICK, ByVal 0&, ByVal 0&)
'Clear
SendDlgItemMessageA hWnd, cBtn, BM_CLICK, ByVal 0&, ByVal 0&
dHwnd = FindWindowEx(hWnd, 0&, "Button", "/")
xHwnd = FindWindowEx(hWnd, 0&, "Button", "*")
aHwnd = FindWindowEx(hWnd, 0&, "Button", "+")
sHwnd = FindWindowEx(hWnd, 0&, "Button", "-")
eHwnd = FindWindowEx(hWnd, 0&, "Button", "=")
hWnd0 = FindWindowEx(hWnd, 0&, "Button", "0")
hWnd1 = FindWindowEx(hWnd, 0&, "Button", "1")
hWnd2 = FindWindowEx(hWnd, 0&, "Button", "2")
hWnd3 = FindWindowEx(hWnd, 0&, "Button", "3")
hWnd4 = FindWindowEx(hWnd, 0&, "Button", "4")
hWnd5 = FindWindowEx(hWnd, 0&, "Button", "5")
hWnd6 = FindWindowEx(hWnd, 0&, "Button", "6")
hWnd7 = FindWindowEx(hWnd, 0&, "Button", "7")
hWnd8 = FindWindowEx(hWnd, 0&, "Button", "8")
hWnd9 = FindWindowEx(hWnd, 0&, "Button", "9")
ary1 = Array(hWnd0, hWnd1, hWnd2, hWnd3, hWnd4, hWnd5, hWnd6, hWnd7, hWnd8, hWnd9)
ary2 = Array(btn0, btn1, btn2, btn3, btn4, btn5, btn6, btn7, btn8, btn9)
Select Case pType
Case "*", "X"
mType = xHwnd
Case "/"
mType = dHwnd
Case "+"
mType = aHwnd
Case "-"
mType = sHwnd
Case Else
mType = 0
End Select
If mType = 0 Then Exit Function
' 1 数字のSet
For i = 1 To Len(str1)
lngRtn = SendMessage(ary1(Mid(str1, i, 1)), BM_CLICK, ByVal 0&, ByVal 0&)
Next
' 四則演算子
lngRtn = SendMessage(mType, BM_CLICK, ByVal 0&, ByVal 0&)
' 2 数字のSet
For i = 1 To Len(str2)
lngRtn = SendMessage(ary1(Mid(str2, i, 1)), BM_CLICK, ByVal 0&, ByVal 0&)
Next
lngRtn = SendMessage(eHwnd, BM_CLICK, ByVal 0&, ByVal 0&)
lngRtn = SendMessage(hEditWnd, WM_GETTEXT, Len(strBuff), ByVal strBuff)
' 結果表示
CalucProc = Left(strBuff, InStr(strBuff, vbNullChar) - 1)
End Function
Sub MainProc()
Dim s1 As String
Dim s2 As String
' 32桁 その後は指数
s1 = "35051000100001000100002000004021"
s2 = "35051000100001000100002000004022"
'結果表示
Debug.Print Trim(CalucProc(s1, s2, "+"))
End Sub
電卓の起動 CalucStart を実行したあとに
MainProcを実行してみて下さい。
第1第2引数は計算値で第3引数は演算子です。
乗算は X or * 除算は / 加算は + 減算は - です。
結果はイミディエイトウィンドウにでます。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
