Đề tài Xây dựng một chương trình tương tự như Microsoft Excel với các chức năng cơ bản

Ngày nay công nghệ thông tin đã và đang ngày càng một phát triển như vũ bão, nó đã xâm nhập vào mọi lĩnh vực như khoa học kỹ thuật, kinh tế, chính trị, Sản phẩm của công nghệ thông tin chủ yếu là các phần mềm ứng dụng. Một trong những ứng dụng quan trọng nhất chính là việc ứng dụng trong quản lý.

doc26 trang | Chia sẻ: vietpd | Lượt xem: 1219 | Lượt tải: 0download
Bạn đang xem trước 20 trang tài liệu Đề tài Xây dựng một chương trình tương tự như Microsoft Excel với các chức năng cơ bản, để xem tài liệu hoàn chỉnh bạn click vào nút DOWNLOAD ở trên
Lời nói đầu Ngày nay công nghệ thông tin đã và đang ngày càng một phát triển như vũ bão, nó đã xâm nhập vào mọi lĩnh vực như khoa học kỹ thuật, kinh tế, chính trị,…Sản phẩm của công nghệ thông tin chủ yếu là các phần mềm ứng dụng. Một trong những ứng dụng quan trọng nhất chính là việc ứng dụng trong quản lý. Phần mềm quản lý phổ biến hiện nay và được ứng dụng khá phổ biến chính là Micrsoft Excel. Phần mềm này được tạo ra đã giúp cho người quản lý tổ chức công việc một cách nhanh chóng, chính xác và có hiệu quả. Chương trình chủ yếu được sử dụng để viết nên phần mềm này chính là Visual Basic. Trên cơ sở đã được học môn Lập trình hướng đối tượng với Visual Basic, tôi chọn đề tài: “Xây dựng một chương trình tương tự như Microsoft Excel với các chức năng cơ bản sau: Cho phép tạo ra các bảng tính . Cho phép gõ dữ liệu thuộc các dạng khác nhau. Cho phép chọn thư mục để in ra file mới, mở file đã có. Cho phép thực hiện các phép tính số học theo hàng và cột Cho phép cắt, dán dữ liệu trên bảng Cho phép chọn các Font chữ khác nhau để soạn” Tuy nhiên, đây chỉ là một chương trình mô phỏng lại MS Excel một cách cơ bản, đơn giản nhất dựa trên những kiến thức mà tôi đã được học tập tại khoa CNTT nên các thuật toán chưa được hợp lý và cách trình bày có thể còn nhiều thiếu sót. Vì vậy, tôi rất mong nhận được sự góp ý của thầy cô và các bạn để chương trình được hoàn thiện hơn. Tôi xin chân thành cảm ơn thầy giáo: GS.TS. Nguyễn Văn Xuất và thầy giáo Nguyễn Quảng Hà đã hướng dẫn tôi làm chương trình này. Nội dung đề tàI Tính cấp thiết của đề tàI Cùng với sự phát triển mạnh mẽ của công nghệ thông tin và cùng với xự xâm nhập nhanh chóng của tin học vào mọi lĩnh vực của đời sống xã hội thì việc sử dụng máy tính trong công tác quản lý đã trở thành một nhu cầu cấp bách, nó là một trong những công cụ không thể thiếu nhằm nâng cao chất lượng và hiệu quả trong công tác quản lý. Cái khó khi quản lý là thao tác với các loại dữ liệu khác nhau vốn rất đa dạng chưa kể tới việc tính toán, sao chép, lưu trữ,… điều này tạo ra khó khăn cho những người lập trình, đặc biệt là lập trình với Excel – một chương trình quản lý đã khá phổ biến từ trước tới nay. Do vậy, việc nâng cấp chương trình này ngày càng phải được thay đổi một cách thường xuyên hơn. Mục đích của đề tàI Bài tiểu luận môn học này phần nào đưa ra một cách nhìn cơ bản khi xây dựng một chương trình tương tự như MS Excel. Chương trình khá đơn giản với 6 chức năng cơ bản: 1. Cho phép tạo ra các bảng tính . Cho phép gõ dữ liệu thuộc các dạng khác nhau (kiểu số, kiểu ký tự, các ký hiệu đặc biệt,…) Cho phép chọn thư mục để in ra file mới, mở file đã có. Cho phép thực hiện các phép tính số học (cộng, trừ, nhân, chia) theo hàng và cột. Cho phép cắt, dán dữ liệu trên bảng 6. Cho phép chọn các Font chữ khác nhau để soạn Sơ đồ thiết kế: Thanh menu gồm có 4 mục Menu File Menu Edit Menu View Menu Help Ngoài ra bạn có thể sử dụng thanh công cụ để điều khiển có chức năng giống như thanh menu. Các đối tượng, công cụ sử dụng: MSHFlex Grid Microsoft Common Dialog Control TextBox Command Button Image List Label Khi Chạy chương trình: Trước tiên để chạy được chương trình này thì máy tính của bạn phải có Microsoft Visual Basic 6.0. V.1 Khi chạy chương trình bạn có thể mở file cũ hoặc mở file mới để làm việc V.2 Ngoài ra bạn có thể chọn Font, cỡ chữ để soạn thảo các BookSheet như bạn muốn. Rồi lưu lại với một file 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 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 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 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 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 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 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" '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 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 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 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)) End If End Sub Private Sub Text3_Click() Text3.Alignment = vbLeftJustify End Sub Private Sub Text3_KeyPress(KeyAscii As Integer) Dim st, st2, st3 As String Dim i, L, k As Long If ActiveForm Is Nothing Then Exit Sub If KeyAscii = 13 Then On Error Resume Next st = UCase(Trim(Text3.Text)) L = Len(st) For i = 1 To L + 1 If Asc(Mid(st, i, 1)) >= 48 And Asc(Mid(st, i, 1)) <= 57 Then GoTo L2 End If Next i L2: st2 = Left(st, i - 1) st3 = Right(st, Len(st) - i + 1) If Len(st2) = 1 Then ActiveForm.Grid1.Col = Asc(UCase(st2)) - 64 ElseIf Len(st2) = 2 Then k = Asc(UCase(Left(st2, 1))) - 64 + 26 ActiveForm.Grid1.Col = k End If ActiveForm.Grid1.Row = Val(st3) ActiveForm.Grid1.FocusRect = flexFocusLight End If End Sub Private Sub Text3_Validate(Cancel As Boolean) Text3.Alignment = vbCenter End Sub FORM frmExcel Private Sub rtfText_SelChange() ' fMainForm.tbToolBar.Buttons("Bold").Value = IIf(rtfText.SelBold, tbrPressed, tbrUnpressed) ' fMainForm.tbToolBar.Buttons("Italic").Value = IIf(rtfText.SelItalic, tbrPressed, tbrUnpressed) ' fMainForm.tbToolBar.Buttons("Underline").Value = IIf(rtfText.SelUnderline, tbrPressed, tbrUnpressed) ' fMainForm.tbToolBar.Buttons("Align Left").Value = IIf(rtfText.SelAlignment = rtfLeft, tbrPressed, tbrUnpressed) ' fMainForm.tbToolBar.Buttons("Center").Value = IIf(rtfText.SelAlignment = rtfCenter, tbrPressed, tbrUnpressed) ' fMainForm.tbToolBar.Buttons("Align Right").Value = IIf(rtfText.SelAlignment = rtfRight, tbrPressed, tbrUnpressed) End Sub Private Sub Form_Load() Dim i, j, k As Integer Me.WindowState = 2 Grid1.MousePointer = flexSizeAll Grid1.Rows = MaxRow '1000 Grid1.Cols = MaxCol '101 Grid1.Row = 0 For i = 1 To MaxCol - 1 Grid1.Col = i Grid1.CellAlignment = 4 'center If Grid1.Col > 26 Then 'Columns AA->... Grid1.Text = Chr(Int((Grid1.Col - 1) / 26) + 64) & Chr(((Grid1.Col - 1) Mod 26) + 65) Else ' Columns A-Z Grid1.Text = Chr(Grid1.Col + 64) End If Next i Grid1.Col = 0 For i = 1 To Grid1.Rows - 1 Grid1.Row = i Grid1.CellAlignment = 4 'Center Grid1.Text = Str(i) Grid1.ColWidth(0) = 550 Next i Grid1.Col = 1 'Vitri ban dau cua TextMain Grid1.Row = 1 End Sub Private Sub Form_Resize() Grid1.Height = ScaleHeight Grid1.Width = ScaleWidth End Sub Private Sub Form_Unload(Cancel As Integer) Dim i As Integer i = MsgBox("Do you want to save change you made to this 'Book'?", vbYesNoCancel + vbDefaultButton1 + vbExclamation, "Excel 2003") If i = vbYes Then Call save_form End If If i = vbCancel Then Cancel = 1 Exit Sub End Sub Public Sub save_form() Dim sFile As String With fMainForm.CommonDialog2 .DialogTitle = "Save" .CancelError = False .Filter = "Book(*.Mp5)|*.Mp5|All Files (*.*)|*.*" .filename = Left$(frmExcel.Caption, 4) .FilterIndex = 1 .ShowSave If Len(.filename) = 0 Then Exit Sub End If sFile = .filename End With Saved sFile End Sub Private Sub Grid1_Click() fMainForm.Text3.Alignment = vbCenter 'Name Box fMainForm.Text2.Text = "" fMainForm.sbStatusBar.Panels(1).Text = " Ready" End Sub Private Sub Grid1_DblClick() fMainForm.Text3.Alignment = vbCenter End Sub Private Sub Grid1_KeyPress(KeyAscii As Integer) fMainForm.sbStatusBar.Panels(1).Text = " Enter" If KeyAscii 13 And KeyAscii 9 And KeyAscii 8 Then Grid1.Text = Grid1.Text + Chr(KeyAscii) fMainForm.Text2.Text = Grid1.Text ' If Len(Grid1.Text) > Grid1.CellWidth Then ' Grid1.CellWidth = Len(Grid1.Text) ' End If End If If KeyAscii = 13 Then If Left(Grid1.Text, 1) = "=" Then Tinh Grid1.Text Else Grid1.Row = Grid1.Row + 1 End If End If If KeyAscii = 9 Then Grid1.Col = Grid1.Col + 1 'Phim Tab If KeyAscii = 8 And Grid1.Text "" Then 'Phim Back Grid1.Text = Left(Grid1.Text, Len(Grid1.Text) - 1) End If End Sub Private Sub Grid1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) 'Name box fMainForm.Text3.Text = Trim(Grid1.TextMatrix(Grid1.RowPos(0), Grid1.Col)) & Trim(Grid1.TextMatrix(Grid1.Row, Grid1.ColPos(0))) 'Grid1.Row = Grid1.RowPos(0) 'Grid1.CellBackColor = vbRed 'Grid1.Col = Grid1.ColPos(0) 'Grid1.CellBackColor = vbRed If Button = vbRightButton Then PopupMenu fMainForm.mnuPopup End If End Sub MODUL.BAS Option Explicit Public Const MaxCol As Long = 51 '101 Public Const MaxRow As Long = 201 '1001 Global Hang, Cot As Long Public fMainForm As MDIMain Sub Main() frmSplash.Show frmSplash.Refresh Set fMainForm = New MDIMain Load fMainForm Unload frmSplash fMainForm.Show End Sub Public Sub Tinh(s As String) Dim i, j, x, y, xt, yt, tg, dau As Integer Dim kq As Double Dim s1, Flag As String Dim Zero As Boolean 'On Error GoTo L3 s = UCase(Right(s, Len(s) - 1)) xt = fMainForm.ActiveForm.Grid1.Row yt = fMainForm.ActiveForm.Grid1.Col tg = Len(s) dau = 0 Zero = False For i = 1 To tg Select Case Left(s, 1) Case "+": x = Asc(Left(s1, 1)) - 64 y = Val(Right(s1, Len(s1) - 1)) fMainForm.ActiveForm.Grid1.Row = y fMainForm.ActiveForm.Grid1.Col = x kq = kq + Val(fMainForm.ActiveForm.Grid1.Text) s1 = "" Flag = "+" Case "-": x = Asc(Left(s1, 1)) - 64 y = Val(Right(s1, Len(s1) - 1)) fMainForm.ActiveForm.Grid1.Row = y fMainForm.ActiveForm.Grid1.Col = x kq = kq - Val(fMainForm.ActiveForm.Grid1.Text) If dau = 0 Then kq = kq * -1 dau = 1 End If 'MsgBox x & "" & y & " " & kq s1 = "" Flag = "-" Case "*": x = Asc(Left(s1, 1)) - 64 y = Val(Right(s1, Len(s1) - 1)) If dau = 0 Then kq = 1 dau = 1 End If fMainForm.ActiveForm.Grid1.Row = y fMainForm.ActiveForm.Grid1.Col = x kq = kq * Val(fMainForm.ActiveForm.Grid1.Text) 'MsgBox x & "" & y & " " & al(fMainForm.ActiveForm.Grid1.Text) s1 = "" Flag = "*" Case ":": x = Asc(Left(s1, 1)) - 64 y = Val(Right(s1, Len(s1) - 1)) fMainForm.ActiveForm.Grid1.Row = y fMainForm.ActiveForm.Grid1.Col = x If dau = 0 Then kq = Val(fMainForm.ActiveForm.Grid1.Text) dau = 1 Else If Val(fMainForm.ActiveForm.Grid1.Text) 0 Then kq = kq / Val(fMainForm.ActiveForm.Grid1.Text) Else MsgBox "Division by zero", vbCritical, "Warning" Zero = True End If End If s1 = "" Flag = ":" Case Else s1 = s1 & Left(s, 1) End Select s = Right(s, Len(s) - 1) tg = Len(s) Next i x = Asc(Left(s1, 1)) - 64 y = Val(Right(s1, Len(s1) - 1)) fMainForm.ActiveForm.Grid1.Row = y fMainForm.ActiveForm.Grid1.Col = x Select Case Flag Case "+": kq = kq + Val(fMainForm.ActiveForm.Grid1.Text) Case "-": kq = kq - Val(fMainForm.ActiveForm.Grid1.Text) Case "*": kq = kq * Val(fMainForm.ActiveForm.Grid1.Text) Case ":": If Val(fMainForm.ActiveForm.Grid1.Text) 0 Then kq = kq / Val(fMainForm.ActiveForm.Grid1.Text) Else MsgBox "Division by zero", vbCritical, "Warning" Zero = True End If End Select fMainForm.ActiveForm.Grid1.Row = xt fMainForm.ActiveForm.Grid1.Col = yt fMainForm.ActiveForm.Grid1.Text = kq If Zero = True Then fMainForm.ActiveForm.Grid1.Text = "False" End If 'L3: MsgBox "Function is not correct", vbCritical, "Warning" End Sub Public Sub Saved(filename As String) Dim FileNum As Integer Dim s As String Dim i, j, x, x1, y, y1 As Long fMainForm.sbStatusBar.Panels(1).Text = " Saving..." x = 1 x1 = MaxRow - 100 y = 1 y1 = MaxCol - 1 For i = x1 To x Step -1 'Down to For j = y1 To y Step -1 fMainForm.ActiveForm.Grid1.Row = i fMainForm.ActiveForm.Grid1.Col = j If fMainForm.ActiveForm.Grid1.Text "" Then Exit For End If Next j Next i s = "" For i = x To x1 For j = y To y1 fMainForm.ActiveForm.Grid1.Row = i fMainForm.ActiveForm.Grid1.Col = j s = s & fMainForm.ActiveForm.Grid1.Text s = s & Chr(vbKeyTab) Next j s = Left(s, Len(s) - 1) 'vbKeytab s = s & Chr(vbKeyReturn) Next i FileNum = FreeFile Open filename For Output As #FileNum Write #FileNum, s Close #FileNum fMainForm.sbStatusBar.Panels(1).Text = " Book save is complete" End Sub Public Sub Saved_Form(filename As String) Dim FileNum As Integer Dim s As String Dim i, j, x, x1, y, y1 As Long fMainForm.sbStatusBar.Panels(1).Text = " Saving..." x = 1 x1 = MaxRow - 100 y = 1 y1 = MaxCol - 1 For i = x1 To x Step -1 'Down to For j = y1 To y Step -1 frmExcel.Grid1.Row = i frmExcel.Grid1.Col = j If frmExcel.Grid1