Xây dựng 1 chương trình tương tự như Microsoft Excel

V.3 Việc tính toán với các phép tính số học cũng đợc thực hiện ngay
trên bảng tính

5
V.4 Tơng tự việc cắt, dán dữ liệu cũng vậy, đều thực hiện trực tiếp trên
bảng
VI. Code chơng trình nguồn:
FORM MDIMAIN
Private Sub Command1_Click()
If Text2.Text <> "" Then
Call Tinh(Trim(Text2.Text))
Else
MsgBox "Formula is null", vbCritical, "Warning"
End If
End Sub
Private Sub Label3_Click()
With CommonDialog1
.CancelError = True
On Error GoTo No_Font_Chosen
.Flags = 1
.ShowFont
6
If ActiveForm Is Nothing Then Exit Sub
ActiveForm.Grid1.CellFontName = .FontName
'Text2.FontName = .FontName
ActiveForm.Grid1.CellFontSize = .FontSize
'Text2.FontSize = .FontSize
ActiveForm.Grid1.CellFontBold = .FontBold
'Text2.FontBold = .FontBold
ActiveForm.Grid1.CellFontUnderline = .FontUnderline
'Text2.FontUnderline = .FontUnderline
ActiveForm.Grid1.CellFontItalic = .FontItalic
'Text2.FontItalic = .FontItalic
ActiveForm.Grid1.FontStrikethru = .FontStrikethru
On Error GoTo 0
Exit Sub
End With
No_Font_Chosen:
End Sub
Private Sub Label5_Click()
Picture4.Visible = False
mnuFormula.Checked = False
mnuPopupFormula.Checked = False
End Sub
Private Sub MDIForm_Load()
Me.WindowState = 2
Text2.Text = ""
Text3.Text = ""
ToolBar1.Height = 329
Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
LoadNewBook
End Sub
Private Sub LoadNewBook()
Static LBookCount As Long
Dim frmB As frmExcel
LBookCount = LBookCount + 1
Set frmB = New frmExcel
7
frmB.Caption = "Book" & LBookCount
frmB.Tag = LBookCount
frmB.Show
End Sub
Private Sub MDIForm_MouseDown(Button As Integer, Shift As Integer, x As
Single, y As Single)
If Button = vbRightButton Then
PopupMenu mnuFile
End If
End Sub
Private Sub MDIForm_Unload(Cancel As Integer)
If Me.WindowState <> vbMinimized Then
SaveSetting App.Title, "Settings", "MainLeft", Me.Left
SaveSetting App.Title, "Settings", "MainTop", Me.Top
SaveSetting App.Title, "Settings", "MainWidth", Me.Width
SaveSetting App.Title, "Settings", "MainHeight", Me.Height
End If
Unload frmExcel
End
End Sub
Private Sub mnuClose_Click()
Call mnuFileClose_Click
End Sub
Private Sub mnuCopy_Click()
Call mnuEditCopy_Click
End Sub
Private Sub mnuCut_Click()
Call mnuEditCut_Click
End Sub
Private Sub mnuEditFind_Click()
Find.Show
End Sub
Private Sub mnuExit_Click()
Call mnuFileExit_Click
8
End Sub
Private Sub mnuFont_Click()
Call Label3_Click
End Sub
Private Sub mnuFormula_Click()
mnuFormula.Checked = Not mnuFormula.Checked
Picture4.Visible = mnuFormula.Checked
End Sub
Private Sub mnuNew_Click()
LoadNewBook
End Sub
Private Sub mnuOpen_Click()
Call mnuFileOpen_Click
End Sub
Private Sub mnuPaste_Click()
Call mnuEditPaste_Click
End Sub
Private Sub mnuPopupFormula_Click()
mnuPopupFormula.Checked = Not mnuPopupFormula.Checked
Picture4.Visible = mnuPopupFormula.Checked
End Sub
Private Sub mnuViewStatusBar_Click()
mnuViewStatusBar.Checked = Not mnuViewStatusBar.Checked
sbStatusBar.Visible = mnuViewStatusBar.Checked
End Sub
Private Sub mnuViewToolbar_Click()
mnuViewToolbar.Checked = Not mnuViewToolbar.Checked
tbToolBar.Visible = mnuViewToolbar.Checked
End Sub
End Sub
Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
If ActiveForm Is Nothing Then Exit Sub
9
On Error Resume Next
Select Case Button.Key
Case "New"
LoadNewBook
Case "Open"
mnuFileOpen_Click
Case "Save"
mnuFileSave_Click
Case "Print"
mnuFilePrint_Click
Case "Cut"
mnuEditCut_Click
Case "Copy"
mnuEditCopy_Click
Case "Paste"
mnuEditPaste_Click
Case "Bold"
ActiveForm.Grid1.CellFontBold = Not
ActiveForm.Grid1.CellFontBold
Button.Value = IIf(ActiveForm.Grid1.CellFontBold, tbrPressed,
tbrUnpressed)
Case "Italic"
ActiveForm.Grid1.CellFontItalic = Not
ActiveForm.Grid1.CellFontItalic
Button.Value = IIf(ActiveForm.Grid1.CellFontItalic, tbrPressed,
tbrUnpressed)
Case "Underline"
ActiveForm.Grid1.CellFontUnderline = Not
ActiveForm.Grid1.CellFontUnderline
Button.Value = IIf(ActiveForm.Grid1.CellFontUnderline, tbrPressed,
tbrUnpressed)
Case "Align Left"
ActiveForm.Grid1.CellAlignment = 1
Case "Center"
ActiveForm.Grid1.CellAlignment = 4
Case "Align Right"
ActiveForm.Grid1.CellAlignment = 7
Case "Sort Ascending"
'ActiveForm.Grid1.Sort = 1
Call Sort_Asc
Case "Sort Descending"
10
'ActiveForm.Grid1.Sort = 2
Call Sort_Desc
Case "Find"
Find.Show
End Select
End Sub
Public Sub Sort_Asc()
Dim i, j, x, x1, y, y1 As Long
x = 1
y = 1
x1 = ActiveForm.Grid1.Row 'MaxRow - 1
y1 = ActiveForm.Grid1.Col 'MaxCol - 1
For i = x To x1
For j = y To y1
fMainForm.ActiveForm.Grid1.Row = i
fMainForm.ActiveForm.Grid1.Col = j
fMainForm.ActiveForm.Grid1.Sort = 1 'Asc
Next j
Next i

End Sub
Public Sub Sort_Desc()
Dim i, j, x, x1, y, y1 As Long
x = 1
y = 1
x1 = ActiveForm.Grid1.Row 'MaxRow - 1
y1 = ActiveForm.Grid1.Col 'MaxCol - 1
For i = x To x1
For j = y To y1
fMainForm.ActiveForm.Grid1.Row = i
fMainForm.ActiveForm.Grid1.Col = j
fMainForm.ActiveForm.Grid1.Sort = 2 'Desc
Next j
Next i

End Sub
Private Sub mnuHelpAbout_Click()
frmAbout.Show vbModal, Me
End Sub
11
Private Sub mnuEditCopy_Click()
On Error Resume Next
Clipboard.SetText ActiveForm.Grid1.TextMatrix(ActiveForm.Grid1.Row,
ActiveForm.Grid1.Col)
End Sub
Private Sub mnuEditPaste_Click()
On Error Resume Next
ActiveForm.Grid1.TextMatrix(ActiveForm.Grid1.Row,
ActiveForm.Grid1.Col) = Clipboard.GetText
End Sub

Private Sub mnuEditCut_Click()
On Error Resume Next
Clipboard.SetText ActiveForm.Grid1.TextMatrix(ActiveForm.Grid1.Row,
ActiveForm.Grid1.Col)
ActiveForm.Grid1.TextMatrix(ActiveForm.Grid1.Row,
ActiveForm.Grid1.Col) = vbNullString
End Sub
Private Sub mnuFileExit_Click()
'unload the form
Unload frmExcel
End
End Sub
Private Sub mnuFilePrint_Click()
On Error Resume Next
If ActiveForm Is Nothing Then Exit Sub
With dlgCommonDialog
.DialogTitle = "Print"
.CancelError = True
.Flags = cdlPDReturnDC + cdlPDNoPageNums
If ActiveForm.Grid1.SelLength = 0 Then
.Flags = .Flags + cdlPDAllPages
Else
.Flags = .Flags + cdlPDSelection
End If
.ShowPrinter
If Err <> MSComDlg.cdlCancel Then
12
ActiveForm.Grid1.SelPrint .hDC
End If
End With
End Sub
Private Sub mnuFileSaveAs_Click()
Dim sFile As String
If ActiveForm Is Nothing Then Exit Sub
With CommonDialog2
.DialogTitle = "Save As"
.CancelError = False
'ToDo: set the flags and attributes of the common dialog control
.Filter = "Book(*.Mp5)|*.Mp5|All Files (*.*)|*.*"
.FilterIndex = 1
.ShowSave
If Len(.filename) = 0 Then
Exit Sub
End If
sFile = .filename
End With
ActiveForm.Caption = sFile
Saved sFile
End Sub
Private Sub mnuFileSave_Click()
Dim sFile As String
If ActiveForm Is Nothing Then Exit Sub
If Left$(ActiveForm.Caption, 4) = "Book" Then
With CommonDialog2
.DialogTitle = "Save"
.CancelError = False
.Filter = "Book(*.Mp5)|*.Mp5|All Files (*.*)|*.*"
.filename = Left$(ActiveForm.Caption, 4)
.FilterIndex = 1
.ShowSave
If Len(.filename) = 0 Then
Exit Sub
End If
sFile = .filename
End With
13
Saved sFile
Else
sFile = ActiveForm.Caption
Saved sFile
End If
End Sub
Private Sub mnuFileClose_Click()
ActiveForm.Hide
End Sub
Private Sub mnuFileOpen_Click()
Dim sFile As String
If ActiveForm Is Nothing Then LoadNewBook
With CommonDialog2
.DialogTitle = "Open"
.CancelError = False
.Filter = "Book(*.Mp5)|*.Mp5|All Files (*.*)|*.*"
.FilterIndex = 1
.ShowOpen
If Len(.filename) = 0 Then
Exit Sub
End If
sFile = .filename
End With
Opened sFile
ActiveForm.Caption = sFile
End Sub
Private Sub mnuFileNew_Click()
LoadNewBook
End Sub
Private Sub Text2_Change()
If ActiveForm Is Nothing Then Exit Sub
ActiveForm.Grid1.Text = Text2.Text
End Sub
Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Call Tinh(Trim(Text2.Text))
14

Xem chi tiết: Xây dựng 1 chương trình tương tự như Microsoft Excel