Как из программы создать книгу Excel - VB
Формулировка задачи:
Помогите разобраться как из программы создавать файлы книг ЭксЭля. Очень надо. Заранее спасибо...
Решение задачи: «Как из программы создать книгу Excel»
textual
Листинг программы
'создаеш 1 textbox (caption=Text1) и 3 CommandButton
'(bttnNew, bttnCalculate, bttnExit
Dim AppExcel As Excel.Application
Private Sub bttnNew_Click()
StartExcel
MakeSheet
AppExcel.Range('A2:E3').Select
Set CData = AppExcel.Selection
For icol = 1 To 5
For irow = 1 To 2
Text1.Text = Text1.Text & Chr(9) & CData(irow, icol)
Next
Text1.Text = Text1.Text & vbCrLf
Next
PrintSheet
SaveSheet
TerminateExcel
End Sub
Sub StartExcel()
Screen.MousePointer = vbHourglass
Set AppExcel = CreateObject('Excel.Application')
Screen.MousePointer = vbDefault
End Sub
Sub MakeSheet()
Dim wSheet As Worksheet
Dim wBook As Workbook
Set wBook = AppExcel.Workbooks.Add
Set wSheet = AppExcel.Sheets(1)
wSheet.Cells(2, 1).Value = '1st Quarter'
wSheet.Cells(2, 2).Value = '2nd Quarter'
wSheet.Cells(2, 3).Value = '3rd Quarter'
wSheet.Cells(2, 4).Value = '4th Quarter'
wSheet.Cells(2, 5).Value = 'Year Total'
wSheet.Cells(3, 1).Value = 123.45
wSheet.Cells(3, 2).Value = 435.56
wSheet.Cells(3, 3).Value = 376.25
wSheet.Cells(3, 4).Value = 425.75
' Format column Headings
Range('A2:E2').Select
With Selection.Font
.Name = 'Verdana'
.FontStyle = 'Bold'
.Size = 12
End With
Range('A2:E2').Select
Selection.Columns.AutoFit
Selection.ColumnWidth = Selection.ColumnWidth * 1.25
Range('A2:E2').Select
With Selection
.HorizontalAlignment = xlCenter
End With
' Format numbers
Range('A3:E3').Select
With Selection.Font
.Name = 'Verdana'
.FontStyle = 'Regular'
.Size = 11
End With
wSheet.Cells(3, 5).Value = '=Sum(A3:D3)'
MsgBox 'The year total is ' & wSheet.Cells(3, 5).Value
End Sub
Sub SaveSheet()
AppExcel.AlertBeforeOverwriting = False
On Error Resume Next
AppExcel.Sheets(1).SaveAs FileName:='c:sales.xls'
End Sub
Sub PrintSheet()
AppExcel.ActiveWorkbook.PrintOut
End Sub
Sub TerminateExcel()
AppExcel.ActiveWorkbook.Close False
AppExcel.Quit
Set AppExcel = Nothing
End Sub
Private Sub bttnExit_Click()
End
End Sub
Private Sub bttnCalculate_Click()
Dim wSheet As Worksheet
Dim wBook As Workbook
Dim expression
StartExcel
expression = InputBox('Enter math expression to evaluate (i.e., 1/cos(3.45)*log(19.004)')
On Error GoTo CalcError
If Trim(expression) <> '' Then
MsgBox AppExcel.Evaluate(expression)
End If
GoTo Terminate
Exit Sub
CalcError:
MsgBox 'Excel returned the following error: ' & vbCrLf & Err.Description
Terminate:
AppExcel.Quit
Set AppExcel = Nothing
End Sub
Private Sub Form_Terminate()
Set AppExcel = Nothing
End Sub