Abundant Technologies - IT Consulting Experts

 Source Code Library

 Code Details

 
Option Explicit Public objExcel As Excel.Application Public bTestMode As Boolean Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Public Sub ExcelProtectSheet(SheetName As String, ProtectPassword As String) objExcel.Sheets(SheetName).Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=ProtectPassword End Sub Public Sub ExcelSaveAs(FileString As String, WritePassword As String) If Dir(FileString) <> "" Then Kill FileString End If objExcel.ActiveWorkbook.SaveAs FileName:=FileString, writerespassword:=WritePassword Exit Sub End Sub Public Sub ExcelSaveAsProtected(FileString As String, ProtectedPassword As String) If Dir(FileString) <> "" Then Kill FileString End If objExcel.ActiveWorkbook.SaveAs FileName:=FileString, Password:=ProtectedPassword End Sub Public Sub ExcelCloseWorkbook() objExcel.ActiveWorkbook.Close End Sub Public Sub ExcelColorCellRed(RowNumber As Long, ColumnNumber As Long) objExcel.Cells(RowNumber, ColumnNumber).Font.ColorIndex = 3 End Sub Public Sub ExcelBoldCell(RowNumber As Long, ColumnNumber As Long) objExcel.Cells(RowNumber, ColumnNumber).Font.Bold = True End Sub Public Sub ExcelCopySheet(FromSheet As String, ToSheet As String) objExcel.Sheets(FromSheet).Copy Before:=Sheets(1) objExcel.Sheets(FromSheet & " (2)").Name = ToSheet End Sub Public Sub ExcelRenameSheet(FromSheet As String, ToSheet As String) objExcel.Sheets(FromSheet).Name = ToSheet End Sub Public Sub ExcelOpen() Set objExcel = CreateObject("Excel.Application") If bTestMode Then objExcel.Visible = True Else objExcel.Visible = False End If End Sub Public Sub ExcelMinimize() If bTestMode Then objExcel.WindowState = xlMinimized End If End Sub Public Sub ExcelMaximized() objExcel.WindowState = xlMaximized End Sub Public Sub ExcelQuit() objExcel.Application.Quit Set objExcel = Nothing End Sub Public Sub ExcelWriteField(RowNumber As Long, ColumnNumber As Long, Value As Field) Dim ValueType As Integer Dim CellValue As Variant ValueType = Value.Type ExcelWriteKnownField RowNumber, ColumnNumber, Value, ValueType End Sub Public Sub ExcelWriteKnownField(RowNumber As Long, ColumnNumber As Long, Value As Field, ValueType As Integer) Dim CellValue As Variant Select Case ValueType Case dbInteger, dbLong, dbCurrency, dbSingle, dbDouble If Not IsNull(Value) Then CellValue = Val(Value) Else CellValue = "0" End If Case dbDate CellValue = Format(Value, "d-m-y h:m AMPM") Case Else CellValue = "'" & Value End Select objExcel.Cells(RowNumber, ColumnNumber).Value = CellValue End Sub Public Sub ExcelWriteText(RowNumber As Long, ColumnNumber As Long, Value As String) objExcel.Cells(RowNumber, ColumnNumber).Value = "'" & Value End Sub Public Sub ExcelWriteFormula(RowNumber As Long, ColumnNumber As Long, Formula As String) objExcel.Cells(RowNumber, ColumnNumber).Value = Formula End Sub Public Sub ExcelChangeStyle(RowNumber As Long, ColumnNumber As Long, Style As String) objExcel.Cells(RowNumber, ColumnNumber).Style = Style End Sub Public Sub ExcelWriteNumber(RowNumber As Long, ColumnNumber As Long, Value As Double) objExcel.Cells(RowNumber, ColumnNumber).Value = Value End Sub Public Sub ExcelSelectSheet(SheetName As String) objExcel.Sheets(SheetName).Select End Sub Public Sub ExcelOpenTemplate(Template As String) objExcel.Workbooks.Add Template:=Template objExcel.ActiveWindow.WindowState = xlMaximized End Sub

Mail To: info@3pc.com