PC WORLD Online - Word İçin Faydalı Makrolar

Hesap Makinesi

İşte tamamen Word makro komutları ile yaratılmış minik bir hesap makinesi. Dört işlem, üs alma, karekök alma komutlarını içeren makromuz basit formülleri de çözümleyebiliyor. Hesaplama sonucunu istediğinizde ekleme noktasının bulunduğu konumdan itibaren Word belgesine yapıştırabiliyor. Bu makroyu istediğiniz gibi düzenleyerek diğer işlemleri de ekleyerek “akıllı” bir Word hesap makinası yaratabilirsiniz.
Sub MAIN

true = - 1
false = 0
Again:
Begin Dialog UserDialog 342, 205, "Hesap Makinesi"
	TextBox 59, 18, 223, 26, .Calculator
	Text 17, 4, 303, 13, "Formülü giriniz:"
	PushButton 25, 114, 44, 21, "1"	'Choice	1
	PushButton 85, 114, 44, 21, "2"		'2
	PushButton 145, 114, 44, 21, "3"		'3
	PushButton 25, 86, 44, 21, "4"		'4
	PushButton 85, 86, 44, 21, "5"		'5
	PushButton 145, 86, 44, 21, "6"		'6
	PushButton 25, 56, 44, 21, "7"		'7
	GroupBox 199, 44, 128, 124, ""
	PushButton 85, 56, 44, 21, "8"		'8
	PushButton 145, 56, 44, 21, "9"		'9
	PushButton 25, 143, 44, 21, "0"		'10
	PushButton 85, 143, 44, 21, "°"		'11
	PushButton 145, 143, 44, 55, "&OK"	'12
	PushButton 212, 114, 44, 21, "+"		'13
	PushButton 266, 86, 44, 21, "--"		'14
	PushButton 212, 86, 44, 21, "X"		'15
	PushButton 212, 55, 44, 21, "/"		'16
	PushButton 266, 55, 44, 21, "%"		'17
	PushButton 266, 114, 44, 21, "&Sq"	'18
	PushButton 212, 141, 44, 21, "&Rt"	'19
	PushButton 266, 141, 44, 21, "&$"		'20
	PushButton 217, 174, 88, 21, "&Bitti"	'21
End Dialog
Dim dlg As UserDialog
dlg.Calculator = Calc$
Choice = Dialog(dlg)
Print Choice
Calc$ = dlg.Calculator
Print Calc$
If Choice = 21 Then Goto Quit
Select Case Choice
Case 1
Calc$ = Calc$ + "1"
Case 2
Calc$ = Calc$ + "2"
Case 3
Calc$ = Calc$ + "3"
Case 4
Calc$ = Calc$ + "4"
Case 5
Calc$ = Calc$ + "5"
Case 6
Calc$ = Calc$ + "6"
Case 7
Calc$ = Calc$ + "7"
Case 8
Calc$ = Calc$ + "8"
Case 9
Calc$ = Calc$ + "9"
Case 10
Calc$ = Calc$ + "0"
Case 11
Calc$ = Calc$ + "."
Case 12
On Error Goto Mistake


For i = 1 To Len(Calc$)
	If Asc(Mid$(Calc$, i, 1)) = 32 Then
	NCalc$ = NCalc$ + "+"
	Goto Try2Again
	Else
	NCalc$ = NCalc$ + Mid$(Calc$, i, 1)
	End If
Try2Again:
Next
Print NCalc$
Calc$ = NCalc$
NCalc$ = ""

Temp$ = ""
If InStr(Calc$, "$") Then Temp$ = "$"

n = ToolsCalculate(Calc$)

If Temp$ = "$" Then
n = ((n * 100) + 0.5) / 100
Else
End If

Calc$ = Str$(n)


For i = 1 To Len(Calc$)
	If Asc(Mid$(Calc$, i, 1)) = 32 Then
	Goto TryAgain
	Else
	NCalc$ = NCalc$ + Mid$(Calc$, i, 1)
	End If
TryAgain:
Next

Calc$ = Temp$ + NCalc$
NCalc$ = ""

If Temp$ = "$" Then
	
	If  InStr(Calc$, ".") = 0 Then
		 Calc$ = Calc$ + ".00"
	ElseIf  InStr(Calc$, ".") Then
		Calc$ = Left$(Calc$, InStr(Calc$, ".") + 2)
	Else
	End If
End If

Begin Dialog UserDialog 342, 205, "Hesap Makinesi"
	PushButton 72, 143, 88, 21, "&Evet"
	PushButton 190, 143, 88, 21, "&Hayır"
	Text 42, 25, 251, 13, "Hesaplama sonucu:"
	TextBox 30, 65, 289, 18, .TextBox1
	Text 30, 99, 285, 13, "Belgeye yapıştırmak için Evet'e, "
	Text 30, 118, 259, 13, "Devam etmek için Hayır'a basın"
End Dialog
Dim dlg2 As UserDialog
dlg2.TextBox1 = Calc$
yn = Dialog(dlg2)
If yn = 1 Then
WW2_Insert Calc$
Else
Goto Again
End If
Case 13
Calc$ = Calc$ + "+"
Case 14
Calc$ = Calc$ + "-"
Case 15
Calc$ = Calc$ + "*"
Case 16
Calc$ = Calc$ + "/"
Case 17
Calc$ = Calc$ + "%"
Case 18
Calc$ = Calc$ + "^2"
Case 19
Calc$ = Calc$ + "^(1/2)"
Case 20
Calc$ = "$" + Calc$
Case 22
Print "HelpDialog Sub"
Call HelpDialog
Case Else
Mistake:
Call ErrorTrap
On Error Goto 0
End Select
Goto Again
Quit:
End Sub

Sub ErrorTrap
L$ = Chr$(13)
Message$ = "Hesaplama hatası" + L$ + "hesap makinesine geri dönülüyor"
Title$ = "Hesaplama Hatası"
MsgBox Message$, Title$, 16
End Sub