Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


18321 / 76732 ←次へ | 前へ→

【63854】Re:桁数が多いと勝手に指数で計算してうまく判定できない
発言  Yuki  - 09/12/22(火) 15:50 -

引用なし
パスワード
   ▼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 * 除算は / 加算は + 減算は - です。
結果はイミディエイトウィンドウにでます。

1 hits

【63725】桁数が多いと勝手に指数で計算してうまく判定できない pon 09/12/3(木) 16:00 質問
【63726】Re:桁数が多いと勝手に指数で計算してうま... ichinose 09/12/3(木) 17:40 発言
【63787】Re:桁数が多いと勝手に指数で計算してうま... pon 09/12/15(火) 12:33 お礼
【63788】Re:桁数が多いと勝手に指数で計算してうま... pon 09/12/15(火) 12:49 質問
【63789】Re:桁数が多いと勝手に指数で計算してうま... Jaka 09/12/15(火) 13:42 発言
【63792】Re:桁数が多いと勝手に指数で計算してうま... pon 09/12/15(火) 16:52 質問
【63794】Re:桁数が多いと勝手に指数で計算してうま... よろずや 09/12/15(火) 19:34 回答
【63853】Re:桁数が多いと勝手に指数で計算してうま... pon 09/12/22(火) 15:26 質問
【63854】Re:桁数が多いと勝手に指数で計算してうま... Yuki 09/12/22(火) 15:50 発言
【63855】Re:桁数が多いと勝手に指数で計算してうま... pon 09/12/22(火) 16:58 質問
【63856】Re:桁数が多いと勝手に指数で計算してうま... pon 09/12/22(火) 19:07 お礼
【63857】Re:桁数が多いと勝手に指数で計算してうま... ichinose 09/12/22(火) 22:09 発言
【63867】Re:桁数が多いと勝手に指数で計算してうま... よろずや 09/12/23(水) 23:45 発言
【63870】Re:桁数が多いと勝手に指数で計算してうま... pon 09/12/24(木) 18:36 お礼
【63868】Re:桁数が多いと勝手に指数で計算してうま... ichinose 09/12/24(木) 7:35 発言
【63871】Re:桁数が多いと勝手に指数で計算してうま... pon 09/12/24(木) 18:40 質問
【63874】Re:桁数が多いと勝手に指数で計算してうま... ichinose 09/12/25(金) 7:25 発言
【63880】Re:桁数が多いと勝手に指数で計算してうま... pon 09/12/25(金) 15:00 お礼
【63797】Re:桁数が多いと勝手に指数で計算してうま... ichinose 09/12/15(火) 21:58 発言
【63802】Re:桁数が多いと勝手に指数で計算してうま... Yuki 09/12/16(水) 13:33 発言
【63881】Re:桁数が多いと勝手に指数で計算してうま... pon 09/12/25(金) 15:01 お礼

18321 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free