Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If [f6] <> "=" Then Exit Sub
Static temp
Static w, j
r1 = Target.Row
c1 = Target.Column
If r1 > 2 And r1 < 7 And c1 > 3 And c1 < 7 Then
a = ""
Select Case r1 & c1
Case 34
a = 1
Case 35
a = 2
Case 36
a = 3
Case 44
a = 4
Case 45
a = 5
Case 46
a = 6
Case 54
a = 7
Case 55
a = 8
Case 56
a = 9
Case 64
a = 0
Case 65
temp = [d1]
[d1] = 0
j = 1
Case 66
If j = 1 Then
[d1] = [d1] + temp
w = 0
j = 0
Else
[d1] = 0
End If
End Select
If a <> "" Then
If w = 1 Then
[d1] = [d1] & a
Else
[d1] = a
w = 1
End If
End If
[a1].Select
End If
End Sub
Sub 初始化计算器外观()
Cells.Clear
Cells.Select
Selection.RowHeight = 44.25
Range("D3").Select
ActiveCell.FormulaR1C1 = "1"
Range("E3").Select
ActiveCell.FormulaR1C1 = "2"
Range("F3").Select
ActiveCell.FormulaR1C1 = "3"
Range("D4").Select
ActiveCell.FormulaR1C1 = "4"
Range("E4").Select
ActiveCell.FormulaR1C1 = "5"
Range("F4").Select
ActiveCell.FormulaR1C1 = "6"
Range("D5").Select
ActiveCell.FormulaR1C1 = "7"
Range("E5").Select
ActiveCell.FormulaR1C1 = "8"
Range("F5").Select
ActiveCell.FormulaR1C1 = "9"
Range("D6").Select
ActiveCell.FormulaR1C1 = "0"
Range("E6").Select
ActiveCell.FormulaR1C1 = "+"
Range("F6").Select
ActiveCell.FormulaR1C1 = "="
Range("D1:F2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("D1:F6").Select
With Selection.Font
.Name = "宋体"
.Size = 36
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Selection.Font.Bold = True
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
Range("D1:F6").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("D1:F2").Select
End Sub
Private Sub Worksheet_Activate()
初始化计算器外观
End Sub
把上面代码贴到一个表的模块上,返回就可以使用了
在Excel的VBA里做加法计算器?有这必要吗?首先EXCEL本身Sum函数就有加法计算功能,没必要在VBA中做。即使放到VBA中,加法也就是c=a+b这种写法。如果是在VBA中做个计算器出来,那也没这个必要,因为Windows系统本身就有计算器,在VBA中只要调用就可以了,用Shell "calc.exe"即可。
实在不知道你想做怎样的加法器,最最简单的如下:
Option Explicit
Public Sub Add()
Dim a As Long, b As Long, c As Long
a = InputBox("please enter the first addend")
b = InputBox("please enter the other addend")
c = a + b
MsgBox c
End Sub
行,真行!给了你代码,其他你还有什么可做的啊。呵呵呵!
a=a+b
简单吧