Quantcast
Channel: VBForums - CodeBank - Visual Basic 6 and earlier
Viewing all articles
Browse latest Browse all 1463

Excel Writer

$
0
0
Project to create an ActiveX DLL which is capable of writing Excel 2007 xlsx files directly.
No need for Excel to be installed.
An xlsx is just a ZIP archive with all kind of XML files and bunch of tables.
After a few weeks of reverse engineering I was able to create this project.

There are no pivot-tables or charts!

This project uses source code written by:
  • Andrew McMillan -> clsZipClass and clsZipFile
  • Steve McMahon -> clsStringBuilder
  • LaVolpe -> Collection Key routines


Also needed is the zlibwapi.dll which can be found in the zlib125dll.zip


Sample code (needs a reference to the created ActiveX DLL)

Code:

Option Explicit

Private Sub Command1_Click()
  Dim cExcel As clsExcel2007
  Dim cWS As clsWorksheet2007
  Dim tCell As tpExcelCell2007
 
  Set cExcel = New clsExcel2007
 
  ' Add the first Worksheet
  Set cWS = cExcel.AddWorkSheet("My first sheet")
 
  tCell = cExcel.NewCellType
  tCell.Row = 1: tCell.Column = 1:  tCell.Value = "A1"
  cWS.AddCellType tCell
 
  tCell = cExcel.NewCellType
  tCell.Row = 2: tCell.Column = 1:  tCell.Value = "A2"
  cWS.AddCellType tCell
 
  tCell = cExcel.NewCellType
  tCell.Row = 3: tCell.Column = 1:  tCell.Value = "A3"
  cWS.AddCellType tCell
 
  tCell = cExcel.NewCellType
  tCell.Row = 4: tCell.Column = 1:  tCell.Value = "A4"
  cWS.AddCellType tCell
 
  tCell = cExcel.NewCellType ' using empty values
  tCell.Row = 1: tCell.Column = 2: tCell.Value = "B1":  tCell.BackColor = vbRed
  cWS.AddCellType tCell
 
  tCell = cExcel.NewCellType ' using empty values
  tCell.Row = 2: tCell.Column = 2: tCell.Value = "B2":  tCell.FontBold = True
  tCell.Comment = "Font Bold"
  cWS.AddCellType tCell
 
  tCell = cExcel.NewCellType ' using empty values
  tCell.Row = 3: tCell.Column = 2: tCell.Value = "B3":  tCell.ForeColor = RGB(0, 127, 0)
  cWS.AddCellType tCell
 
  tCell = cExcel.NewCellType ' using empty values
  tCell.Row = 4: tCell.Column = 2: tCell.Value = "B4":  tCell.BorderLeftColor = vbBlue
  tCell.Comment = "Blue border"
  cWS.AddCellType tCell
 
  ' Add a second WorkSheet
  Set cWS = cExcel.AddWorkSheet("Sheet 2")
 
  tCell = cExcel.NewCellType
  tCell.Row = 1: tCell.Column = 1:  tCell.Value = Atn(1) * 4
  tCell.FormatString = "0.00"
  cWS.AddCellType tCell
 
  tCell = cExcel.NewCellType
  tCell.Row = 2: tCell.Column = 1:  tCell.Value = Date
  tCell.FormatString = "dd MMM yyyy"
  tCell.Comment = tCell.FormatString

 
  tCell = cExcel.NewCellType
  tCell.Row = 2: tCell.Column = 1:  tCell.Value = TimeSerial(25, 34, 12)
  tCell.FormatString = "[h]:mm"
  tCell.Comment = tCell.FormatString
  cWS.AddCellType tCell


  tCell = cExcel.NewCellType
  tCell.Row = 1: tCell.Column = 2: tCell.Value = "MergeCell"
  cWS.AddCellType tCell
 
  tCell = cExcel.NewCellType
  tCell.Row = 2: tCell.Column = 2: tCell.Value = "MergeCell"
  cWS.AddCellType tCell
 
  tCell = cExcel.NewCellType
  tCell.Row = 3: tCell.Column = 2: tCell.Value = "B3"
  tCell.HorizontalAlignment = chaCenter
  cWS.AddCellType tCell

  tCell = cExcel.NewCellType
  tCell.Row = 4: tCell.Column = 2: tCell.Value = "right"
  tCell.HorizontalAlignment = chaRight
  cWS.AddCellType tCell


  cWS.MergeCells 1, 2, 2, 2
 
  cExcel.Save "D:\Excel 2007 files\Reports\Test1.xlsx"
 
  cExcel.Terminate
 
  Set cWS = Nothing
  Set cExcel = Nothing
End Sub

Private Sub Command2_Click()
  Dim cExcel As clsExcel2007
  Dim cWS As clsWorksheet2007
  Dim tCell As tpExcelCell2007
  Dim lRow As Long, lCol As Long
 
  Set cExcel = New clsExcel2007
 
  Set cWS = cExcel.AddWorkSheet("Single sheet")
  For lRow = 1 To 200
    For lCol = 1 To 500
      tCell = cExcel.NewCellType
      tCell.Row = lRow
      tCell.Column = lCol
      tCell.Value = lRow * lCol
      cWS.AddCellType tCell
    Next lCol
  Next lRow
     
  cExcel.Save "D:\Excel 2007 files\Reports\Test2.xlsx"

  cWS.Terminate
  cExcel.Terminate
 
  Set cWS = Nothing
  Set cExcel = Nothing

End Sub

Attached Files

Viewing all articles
Browse latest Browse all 1463

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>