home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 6 / mastvb6.iso / ch_code / ch14 / excelvba / excelvba.frm (.txt) next >
Encoding:
Visual Basic Form  |  1996-05-27  |  5.6 KB  |  190 lines
  1. VERSION 5.00
  2. Begin VB.Form ExcelVBA 
  3.    Caption         =   "Excel VBA Demo"
  4.    ClientHeight    =   3855
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   8070
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   3855
  10.    ScaleWidth      =   8070
  11.    StartUpPosition =   3  'Windows Default
  12.    Begin VB.TextBox Text1 
  13.       BeginProperty Font 
  14.          Name            =   "Courier New"
  15.          Size            =   9
  16.          Charset         =   0
  17.          Weight          =   400
  18.          Underline       =   0   'False
  19.          Italic          =   0   'False
  20.          Strikethrough   =   0   'False
  21.       EndProperty
  22.       Height          =   3000
  23.       Left            =   105
  24.       MultiLine       =   -1  'True
  25.       ScrollBars      =   3  'Both
  26.       TabIndex        =   3
  27.       Top             =   105
  28.       Width           =   7860
  29.    End
  30.    Begin VB.CommandButton bttnCalculate 
  31.       Caption         =   "Calculate Expression"
  32.       BeginProperty Font 
  33.          Name            =   "Verdana"
  34.          Size            =   9.75
  35.          Charset         =   0
  36.          Weight          =   400
  37.          Underline       =   0   'False
  38.          Italic          =   0   'False
  39.          Strikethrough   =   0   'False
  40.       EndProperty
  41.       Height          =   555
  42.       Left            =   2460
  43.       TabIndex        =   2
  44.       Top             =   3225
  45.       Width           =   2220
  46.    End
  47.    Begin VB.CommandButton bttnExit 
  48.       Caption         =   "Exit Demo"
  49.       BeginProperty Font 
  50.          Name            =   "Verdana"
  51.          Size            =   9.75
  52.          Charset         =   0
  53.          Weight          =   400
  54.          Underline       =   0   'False
  55.          Italic          =   0   'False
  56.          Strikethrough   =   0   'False
  57.       EndProperty
  58.       Height          =   555
  59.       Left            =   5745
  60.       TabIndex        =   1
  61.       Top             =   3225
  62.       Width           =   2220
  63.    End
  64.    Begin VB.CommandButton bttnNew 
  65.       Caption         =   "Make New Sheet"
  66.       BeginProperty Font 
  67.          Name            =   "Verdana"
  68.          Size            =   9.75
  69.          Charset         =   0
  70.          Weight          =   400
  71.          Underline       =   0   'False
  72.          Italic          =   0   'False
  73.          Strikethrough   =   0   'False
  74.       EndProperty
  75.       Height          =   555
  76.       Left            =   135
  77.       TabIndex        =   0
  78.       Top             =   3225
  79.       Width           =   2220
  80.    End
  81. Attribute VB_Name = "ExcelVBA"
  82. Attribute VB_GlobalNameSpace = False
  83. Attribute VB_Creatable = False
  84. Attribute VB_PredeclaredId = True
  85. Attribute VB_Exposed = False
  86. '  ******************************
  87. '  ******************************
  88. '  ** MASTERING VB6            **
  89. '  ** by Evangelos Petroutos   **
  90. '  ** SYBEX, 1998              **
  91. '  ******************************
  92. '  ******************************
  93. Dim AppExcel As Excel.Application
  94. Private Sub bttnNew_Click()
  95.     StartExcel
  96.     MakeSheet
  97.     AppExcel.Range("A2:E3").Select
  98.     Set CData = AppExcel.Selection
  99.     For icol = 1 To 5
  100.         For irow = 1 To 2
  101.             Text1.Text = Text1.Text & Chr(9) & CData(irow, icol)
  102.         Next
  103.         Text1.Text = Text1.Text & vbCrLf
  104.     Next
  105.         
  106.     PrintSheet
  107.     SaveSheet
  108.     TerminateExcel
  109. End Sub
  110. Sub StartExcel()
  111.     Screen.MousePointer = vbHourglass
  112.     Set AppExcel = CreateObject("Excel.Application")
  113.     Screen.MousePointer = vbDefault
  114. End Sub
  115. Sub MakeSheet()
  116. Dim wSheet As Worksheet
  117. Dim wBook As Workbook
  118.     Set wBook = AppExcel.Workbooks.Add
  119.     Set wSheet = AppExcel.Sheets(1)
  120.     wSheet.Cells(2, 1).Value = "1st Quarter"
  121.     wSheet.Cells(2, 2).Value = "2nd Quarter"
  122.     wSheet.Cells(2, 3).Value = "3rd Quarter"
  123.     wSheet.Cells(2, 4).Value = "4th Quarter"
  124.     wSheet.Cells(2, 5).Value = "Year Total"
  125.     wSheet.Cells(3, 1).Value = 123.45
  126.     wSheet.Cells(3, 2).Value = 435.56
  127.     wSheet.Cells(3, 3).Value = 376.25
  128.     wSheet.Cells(3, 4).Value = 425.75
  129. ' Format column Headings
  130.     Range("A2:E2").Select
  131.     With Selection.Font
  132.         .Name = "Verdana"
  133.         .FontStyle = "Bold"
  134.         .Size = 12
  135.     End With
  136.     Range("A2:E2").Select
  137.     Selection.Columns.AutoFit
  138.     Selection.ColumnWidth = Selection.ColumnWidth * 1.25
  139.     Range("A2:E2").Select
  140.     With Selection
  141.         .HorizontalAlignment = xlCenter
  142.     End With
  143. ' Format numbers
  144.     Range("A3:E3").Select
  145.     With Selection.Font
  146.         .Name = "Verdana"
  147.         .FontStyle = "Regular"
  148.         .Size = 11
  149.     End With
  150.     wSheet.Cells(3, 5).Value = "=Sum(A3:D3)"
  151.     MsgBox "The year total is " & wSheet.Cells(3, 5).Value
  152. End Sub
  153. Sub SaveSheet()
  154.     AppExcel.AlertBeforeOverwriting = False
  155. On Error Resume Next
  156.     AppExcel.Sheets(1).SaveAs FileName:="c:\sales.xls"
  157. End Sub
  158. Sub PrintSheet()
  159.     AppExcel.ActiveWorkbook.PrintOut
  160. End Sub
  161. Sub TerminateExcel()
  162.     AppExcel.ActiveWorkbook.Close False
  163.     AppExcel.Quit
  164.     Set AppExcel = Nothing
  165. End Sub
  166. Private Sub bttnExit_Click()
  167.     End
  168. End Sub
  169. Private Sub bttnCalculate_Click()
  170. Dim wSheet As Worksheet
  171. Dim wBook As Workbook
  172. Dim expression
  173.     StartExcel
  174.     expression = InputBox("Enter math expression to evaluate (i.e., 1/cos(3.45)*log(19.004)")
  175. On Error GoTo CalcError
  176.     If Trim(expression) <> "" Then
  177.         MsgBox AppExcel.Evaluate(expression)
  178.     End If
  179.     GoTo Terminate
  180.     Exit Sub
  181. CalcError:
  182.     MsgBox "Excel returned the following error: " & vbCrLf & Err.Description
  183. Terminate:
  184.     AppExcel.Quit
  185.     Set AppExcel = Nothing
  186. End Sub
  187. Private Sub Form_Terminate()
  188.     Set AppExcel = Nothing
  189. End Sub
  190.