HOME > エクセルVBA > サンプル > Calc

Calc


【ファイル名】Calc.xlsm
【バージョン】Ver 1.2.0.0
【作成日】2021年06月21日
【更新日】2021年06月23日
【動作確認】Windows 10
【必要なソフト】Microsoft Excel 2010
【ダウンロード】Calc.zip
【説明】簡単な電卓です。ボタンのイベントを共有するサンプルです。

画面

customUI14.xml
<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="onLoad">
  <ribbon startFromScratch="false">
    <tabs>
      <tab id="Tab1" label="サンプル" insertBeforeMso="TabHome" keytip="S">
        <group id="Group1" label="電卓">
          <button id="ShowFormButton" label="フォームを表示" keytip="S" size="large" imageMso="Calculator"
                  supertip="電卓のフォームを表示します。" onAction="onAction" />
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>
このページの上

clsCalc
Option Explicit

Private WithEvents Btn As MSForms.CommandButton

Public Sub SetBtn(ByVal NewButton As MSForms.CommandButton)
  Set Btn = NewButton
End Sub

Private Sub Btn_Click() ' 共通のボタンのクリック処理
  Call Calc(Btn.Caption)
End Sub

Public Sub Calc(ByVal Caption As String) ' ボタンかキーの処理
  Dim iNum ' 入力した数字 (CalcForm.TextBox1.Text)
  
  iNum = Val(CalcForm.TextBox1.Text)
  Select Case Caption
    Case "C" ' Clear
      Call Reset
    Case "CE" ' Clear Entry
      CalcForm.TextBox1.Text = "0"
    Case "BS" ' Back Space
      If CalcForm.IsBeforeOperation Then Exit Sub ' 直前が演算子なら、何もしない
      If Len(CalcForm.TextBox1.Text) > 1 Then
        CalcForm.TextBox1.Text = Left(CalcForm.TextBox1.Text, Len(CalcForm.TextBox1.Text) - 1)
      Else
        CalcForm.TextBox1.Text = "0"
      End If
    Case "."
      If InStr(CalcForm.TextBox1.Text, ".") = 0 Then
        CalcForm.TextBox1.Text = CalcForm.TextBox1.Text & "."
      End If
    Case "+", "-", "*", "/"
      Select Case CalcForm.Opl ' 前回の演算子
        Case "+"
          CalcForm.Ans = CalcForm.Ans + iNum
          CalcForm.TextBox1.Text = str(CalcForm.Ans)
        Case "-"
          CalcForm.Ans = CalcForm.Ans - iNum
          CalcForm.TextBox1.Text = str(CalcForm.Ans)
        Case "*"
          CalcForm.Ans = CalcForm.Ans * iNum
          CalcForm.TextBox1.Text = str(CalcForm.Ans)
        Case "/"
          If iNum = 0 Then
            Call Reset
            MsgBox Prompt:="0で割ることはできません。", Buttons:=vbCritical + vbSystemModal, Title:="エラー"
          Else
            CalcForm.Ans = CalcForm.Ans / iNum
            CalcForm.TextBox1.Text = str(CalcForm.Ans)
          End If
      End Select
      CalcForm.Opl = Caption
    Case "="
      Select Case CalcForm.Opl
        Case "+"
          CalcForm.Ans = CalcForm.Ans + iNum
        Case "-"
          CalcForm.Ans = CalcForm.Ans - iNum
        Case "*"
          CalcForm.Ans = CalcForm.Ans * iNum
        Case "/"
          If iNum = 0 Then
            Call Reset
            MsgBox Prompt:="0で割ることはできません。", Buttons:=vbCritical + vbSystemModal, Title:="エラー"
          Else
            CalcForm.Ans = CalcForm.Ans / iNum
          End If
      End Select
      CalcForm.TextBox1.Text = str(CalcForm.Ans)
      CalcForm.Opl = ""
    Case Else
      Dim snum As String ' 入力した数字の文字列 (CalcForm.TextBox1.Text)
      Dim bnum As String ' ボタンの数字の文字 (Caption)
      
      bnum = Caption
      snum = CalcForm.TextBox1.Text
      If snum = "0" Then
        CalcForm.TextBox1.Text = bnum
      ElseIf CalcForm.IsBeforeOperation Then ' 直前が演算子の場合は、答えを保存する。
        CalcForm.Ans = Val(snum)
        CalcForm.TextBox1.Text = bnum
      Else
        CalcForm.TextBox1.Text = snum + bnum
      End If
  End Select
  
  Select Case Caption
    Case "+", "-", "*", "/"
      CalcForm.IsBeforeOperation = True
    Case Else
      CalcForm.IsBeforeOperation = False
  End Select
  
  CalcForm.TextBox1.SelStart = Len(CalcForm.TextBox1.Text) ' カーソルの位置を最後にする
  CalcForm.TextBox1.SelLength = 0
End Sub

Private Sub Reset() ' リセット
  CalcForm.Ans = 0
  CalcForm.IsBeforeOperation = False
  CalcForm.Opl = ""
  CalcForm.TextBox1.Text = "0"
  CalcForm.TextBox1.SelStart = Len(CalcForm.TextBox1.Text) ' カーソルの位置を最後にする
  CalcForm.TextBox1.SelLength = 0
End Sub

Private Sub Class_Initialize()
  Call Reset   ' リセット
End Sub
このページの上

UserForm1
Option Explicit

Public IsBeforeOperation As Boolean ' 直前のボタンが演算子か?
Public Ans As Double ' 答え
Public Opl As String ' 前回の演算子 +、-、*、/
Private arrCalc() As clsCalc ' ボタンのクラスの配列

Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Button <> xlSecondaryButton Then Exit Sub ' 右クリックでなければ終了
  With Application.CommandBars.Add(Position:=msoBarPopup, Temporary:=True) ' ポップアップ メニューを表示する
    With .Controls.Add(msoControlButton)
      .Caption = "コピー(&C)"
      .Enabled = TextBox1.SelLength > 0
      .FaceId = 19
      .onAction = "edCopy"
    End With
    
    With .Controls.Add(msoControlButton)
      .Caption = "貼り付け(&V)"
      .Enabled = TextBox1.CanPaste
      .FaceId = 22
      .onAction = "edPaste"
    End With
    
    .ShowPopup
    .Delete
  End With
End Sub

Private Sub UserForm_Initialize() ' 初期化
  Dim Ctrl As MSForms.control
  Dim i As Long
  
  i = 0
  For Each Ctrl In Controls ' ボタンのイベントを共有する
    If TypeOf Ctrl Is MSForms.CommandButton Then
      i = i + 1
      ReDim Preserve arrCalc(1 To i)
      Set arrCalc(i) = New clsCalc
      arrCalc(i).SetBtn Ctrl
    End If
  Next
End Sub

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
  Select Case KeyAscii
    Case Asc("0") To Asc("9"), Asc(".")
      If CalcForm.IsBeforeOperation Or TextBox1.Text = "0" Then
        arrCalc(1).Calc (Chr(KeyAscii))
      Else
        Exit Sub
      End If
    Case Asc("+"), Asc("-"), Asc("*"), Asc("/")
      arrCalc(1).Calc (Chr(KeyAscii))
    Case Else
  End Select
  
  KeyAscii = 0
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  Const fmCtrlMask = 2
  
  If Shift And fmCtrlMask = fmCtrlMask Then ' Ctrl
    Select Case KeyCode
      Case VBA.KeyCodeConstants.vbKeyA, vbKeyC, vbKeyV
        Exit Sub
    End Select
  End If
  
  Select Case KeyCode
    Case vbKeyReturn
      arrCalc(1).Calc ("=")
      KeyCode = 0
    Case vbKeyEscape
      arrCalc(1).Calc ("C")
      KeyCode = 0
    Case vbKey0 To vbKey9
    Case vbKeyNumpad0 To vbKeyNumpad9
    Case 107, 109, 106, 111, 110, 189, 190 ' + - * / . - .
    Case vbKeyTab, vbKeyDelete, vbKeyBack, vbKeyLeft, vbKeyRight
    Case Else
      KeyCode = 0
  End Select
End Sub
このページの上

Module1
Option Explicit

Private rbRibbonUI As IRibbonUI   ' リボン

Sub onLoad(ribbon As IRibbonUI) ' リボンの初期処理
  Set rbRibbonUI = ribbon ' リボンの表示を更新できるようにするためにリボンをセットする
  rbRibbonUI.Invalidate ' リボンの表示を更新します。
End Sub

Sub onAction(control As IRibbonControl) ' 各メニューの処理
  On Error GoTo ErrorHandler ' エラー処理ルーチン
  
  Select Case control.ID
    Case "ShowFormButton"
      CalcForm.Show vbModal
    Case Else
      Beep ' 警告音
      MsgBox Prompt:=control.ID & "の処理がありません!", Buttons:=vbCritical + vbSystemModal, Title:="エラー"
      Exit Sub
  End Select
  
  Exit Sub
'
ErrorHandler: ' エラー処理ルーチン
  Beep ' 警告音
  MsgBox Prompt:="エラー番号:" & Err.Number & vbCrLf & Err.Description, Buttons:=vbCritical + vbSystemModal, Title:="エラー"
End Sub

Public Sub edCopy() ' コピー
  CalcForm.TextBox1.Copy
End Sub

Public Sub edPaste() ' 貼り付け
  CalcForm.TextBox1.Paste
End Sub
このページの上