VBAで電卓 【備忘録】

今、次の職場の契約の都合上、本社で待機しているのですが。
やることなくて暇なので、VBAで電卓作ってみた。
掛け算、割り算は先に計算してくれるようなヤツ。
後、小計を出して、その小計に対して掛けたり割ったりもできたりする。

コントロールツールボックスから、
0〜9までの数字ボタンと、「.」ボタン
+-*/ の演算子ボタン
小計、合計、クリアボタン
を作成
あと、表示欄をラベルで作成

んで、各部品の名前は、下記のプログラムを参照ってことで。

ちなみに、コレ。
いつかAndroidで電卓作ってみようと思ってるので、そのための備忘録w
計算機のロジックとしては、これであってるハズなので〜

↓ こっから、プログラム ↓

Option Explicit

Private m_sum As Double
Private m_row As Integer
Private m_input As Double
Private m_inputStr As String
Private m_preValue As Double
Private m_math As Integer

 

Private Sub btn0_Click()
    m_inputStr = m_inputStr & "0"
    lblDisp.Caption = formatDouble(CDbl(m_inputStr))
End Sub

Private Sub btn1_Click()
    m_inputStr = m_inputStr & "1"
    lblDisp.Caption = formatDouble(CDbl(m_inputStr))
End Sub

Private Sub btn2_Click()
    m_inputStr = m_inputStr & "2"
    lblDisp.Caption = formatDouble(CDbl(m_inputStr))
End Sub

Private Sub btn3_Click()
    m_inputStr = m_inputStr & "3"
    lblDisp.Caption = formatDouble(CDbl(m_inputStr))
End Sub

Private Sub btn4_Click()
    m_inputStr = m_inputStr & "4"
    lblDisp.Caption = formatDouble(CDbl(m_inputStr))
End Sub

Private Sub btn5_Click()
    m_inputStr = m_inputStr & "5"
    lblDisp.Caption = formatDouble(CDbl(m_inputStr))
End Sub

Private Sub btn6_Click()
    m_inputStr = m_inputStr & "6"
    lblDisp.Caption = formatDouble(CDbl(m_inputStr))
End Sub

Private Sub btn7_Click()
    m_inputStr = m_inputStr & "7"
    lblDisp.Caption = formatDouble(CDbl(m_inputStr))
End Sub

Private Sub btn8_Click()
    m_inputStr = m_inputStr & "8"
    lblDisp.Caption = formatDouble(CDbl(m_inputStr))
End Sub

Private Sub btn9_Click()
    m_inputStr = m_inputStr & "9"
    lblDisp.Caption = formatDouble(CDbl(m_inputStr))
End Sub

Private Sub btnAdd_Click()
    If Len(m_inputStr) = 0 Then
        If m_math = 5 Then
            '小計の直後なら、演算を置き換えて終了
            m_math = 1
            'デバッグ用
            m_row = m_row + 1
            Cells(m_row, 11).Value = "+"
            Exit Sub
        End If

        MsgBox "数値を入力してください"
        Exit Sub
    End If
    '入力値のチェックと設定
    If Not inputChk Then
        Exit Sub
    End If
   
    'デバッグ用
    m_row = m_row + 1
    Cells(m_row, 10).Value = m_input
    Cells(m_row, 11).Value = "+"
   
    '前回計算値を算出
    Call summaryInput
   
    '足し算なので、合計エリアに前回計算値を加算する
    m_sum = m_sum + m_preValue
    m_preValue = 0
    '今回選択した演算を保存
    m_math = 1

End Sub

Private Sub btnDel_Click()
    If Len(m_inputStr) = 0 Then
        If m_math = 5 Then
            '小計の直後なら、演算を置き換えて終了
            m_math = 2
            'デバッグ用
            m_row = m_row + 1
            Cells(m_row, 11).Value = "-"
            Exit Sub
        End If
        MsgBox "数値を入力してください"
        Exit Sub
    End If
    '入力値のチェックと設定
    If Not inputChk Then
        Exit Sub
    End If
   
    'デバッグ用
    m_row = m_row + 1
    Cells(m_row, 10).Value = m_input
    Cells(m_row, 11).Value = "-"
   
    '前回計算値を算出
    Call summaryInput
   
    '引き算なので、合計エリアに前回計算値を加算する
    m_sum = m_sum + m_preValue
    m_preValue = 0
    '今回選択した演算を保存
    m_math = 2

End Sub

Private Sub btnDev_Click()
    If Len(m_inputStr) = 0 Then
        If m_math = 5 Then
            '小計の直後なら、演算を置き換えて、合計値を前回計算値に移動
            m_math = 4
            m_preValue = m_sum
            m_sum = 0
            'デバッグ用
            m_row = m_row + 1
            Cells(m_row, 11).Value = "/"
            Exit Sub
        End If
        MsgBox "数値を入力してください"
        Exit Sub
    End If
    '入力値のチェックと設定
    If Not inputChk Then
        Exit Sub
    End If
   
    'デバッグ用
    m_row = m_row + 1
    Cells(m_row, 10).Value = m_input
    Cells(m_row, 11).Value = "/"
   
    '前回計算値を算出
    Call summaryInput
   
    '割り算なので、合計エリアには加算なし
   
    '今回選択した演算を保存
    m_math = 4

End Sub

Private Sub btnMul_Click()
    If Len(m_inputStr) = 0 Then
        If m_math = 5 Then
            '小計の直後なら、演算を置き換えて、合計値を前回計算値に移動
            m_math = 3
            m_preValue = m_sum
            m_sum = 0
            'デバッグ用
            m_row = m_row + 1
            Cells(m_row, 11).Value = "*"
            Exit Sub
        End If
        MsgBox "数値を入力してください"
        Exit Sub
    End If
    '入力値のチェックと設定
    If Not inputChk Then
        Exit Sub
    End If
   
    'デバッグ用
    m_row = m_row + 1
    Cells(m_row, 10).Value = m_input
    Cells(m_row, 11).Value = "*"
   
    '前回計算値を算出
    Call summaryInput
   
    'かけ算なので、合計エリアには加算なし
   
    '今回選択した演算を保存
    m_math = 3

End Sub

Private Sub btnPoint_Click()
    If InStr(1, m_inputStr, ".") > 0 Then
        Exit Sub
    End If
    If Len(m_inputStr) = 0 Then
        m_inputStr = 0
    End If
    m_inputStr = m_inputStr & "."
    lblDisp.Caption = formatDouble(CDbl(m_inputStr))
   
End Sub

Private Sub btnSum_Click()
    If Len(m_inputStr) = 0 Then
        MsgBox "数値を入力してください"
        Exit Sub
    End If
    '入力値のチェックと設定
    If Not inputChk Then
        Exit Sub
    End If
   
    'デバッグ用
    m_row = m_row + 1
    Cells(m_row, 10).Value = m_input
    Cells(m_row, 11).Value = "小計"
   
    '前回計算値を算出
    Call summaryInput
   
    '小計なので、計算値を加算
    m_sum = m_sum + m_preValue
    m_preValue = 0
    '今回選択した演算を保存
    m_math = 5
    '小計を表示
    lblDisp.Caption = formatDouble(m_sum)

End Sub

Private Sub cmdClear_Click()
    Call clear
    lblDisp = "0"

    'デバッグ用
    Range("J:K").ClearContents

End Sub

Private Sub cmdEnd_Click()
    If Len(m_inputStr) = 0 Then
        MsgBox "数値を入力してください"
        Exit Sub
    End If
    '入力値のチェックと設定
    If Not inputChk Then
        Exit Sub
    End If
   
    'デバッグ用
    m_row = m_row + 1
    Cells(m_row, 10).Value = m_input
    Cells(m_row, 11).Value = "合計"
   
    '前回計算値を算出
    Call summaryInput
   
    m_sum = m_sum + m_preValue
    '合計を表示
    lblDisp.Caption = formatDouble(m_sum)
   
    Call clear

End Sub

Private Sub clear()
    m_row = 0
    m_sum = 0
    m_preValue = 0
    m_math = 0
    m_input = 0
    m_inputStr = ""
   
End Sub

Private Sub summaryInput()
    '今回入力値で前回計算値を算出
    Select Case m_math
        Case 0
            m_preValue = m_input
        Case 1
            m_preValue = m_input
        Case 2
            m_preValue = m_input * -1
        Case 3
            m_preValue = m_preValue * m_input
        Case 4
            m_preValue = m_preValue / m_input
        Case 5
            '小計が置き換わってなければ、足し算として考える
            m_preValue = m_input
    End Select
End Sub

Private Function formatDouble(val As Double) As String

    Dim strVal As String
    Dim vals() As String
    Dim ret As String
   
    strVal = CStr(val)
    vals = Split(strVal, ".")
   
    Dim idx As Integer
    Dim cnt As Integer
    cnt = 0
   
    For idx = Len(vals(0)) To 1 Step -1
        cnt = cnt + 1
        If cnt = 3 And idx > 1 Then
            cnt = 0
            vals(0) = Left(vals(0), idx - 1) & "," & Mid(vals(0), idx)
        End If
    Next idx
   
    If LBound(vals) = UBound(vals) Then
        ret = vals(0)
    Else
        If Len(vals(1)) = 0 Then
            ret = vals(0)
        Else
            ret = vals(0) & "." & vals(1)
        End If
    End If
    formatDouble = ret
End Function

Private Function inputChk() As Boolean
    inputChk = True
    m_input = CDbl(m_inputStr)
    m_inputStr = ""
    lblDisp.Caption = "0"
    If m_math = 4 And m_input = 0 Then
        MsgBox "0で割ることはできません" & vbCrLf & "数値を入力し直してください"
        inputChk = False
    End If
End Function


スポンサーサイト


コメント
電卓で悩んでいたコンマ区切りの表示が可能なソースの提供には感謝しています。
今、ソースの解析を私なりに行っていますが、初心者なもので、理解に苦しんでいます。
動作は間違いなくしていますが、問題点としては、キーボード操作が不可能なことと、表示桁数だと思います。
表示桁数は、テキストボックスの文字数制限で可能だと思いますが、キーボード操作は、GetAsyncKeyState が反応しません。キーボード操作を可能にする手法をご指導いただけないでしょうか?
よろしくお願いします。
  • Terumi Ikeda
  • 2013/03/01 10:41 PM
どーもです。
まあ、これ、VBAですし、UIじゃなくて計算部分がメインですからねぇ。

で、GetAsyncKeyStateって、言語なんでしょう?
まずはその辺からちゃんと情報くれないと、こたえようがないですよ?

私はC#、VB、Flexあたりをいま使ってて、Javaも経験ありますけど、さすがにメソッド名とか覚えてないもので(苦笑

ちなみに、キーボード操作がしたかったら、KeyDownイベント拾って、それぞれのメソッド呼び出せばできるはず。
FormでKeyDownイベント拾っちゃえばいけるはず。
いま、動作環境ないとこで書いてるのでアレですがw

まあ、色々やってみると、勉強になりますよ。
困ったらぐーぐる先生に聞いてみてw
  • SouRin(すぅりん)
  • 2013/03/02 9:25 PM
コメントする








    

すぅりんの気の抜けた日常

まぁ色々とあるけど、のほほんと生きていますよ?

calendar

S M T W T F S
   1234
567891011
12131415161718
19202122232425
2627282930  
<< November 2017 >>

Profile

ついったぁ

ブログランキング参加ちぅ

↓良かったら、ぽちっと押してくださいね
blogram投票ボタン

Selected entries

Categories

Archives

Recent comment

Recent trackback

Links

sponsored links

mobile

qrcode

Search

Others

powered

無料ブログ作成サービス JUGEM