Skip to content

Instantly share code, notes, and snippets.

@a-r-d
Created April 4, 2012 04:43
Show Gist options
  • Save a-r-d/2297847 to your computer and use it in GitHub Desktop.
Save a-r-d/2297847 to your computer and use it in GitHub Desktop.
Excel file report generator Outline/ template script. Form layout not included!
'WHAT IS THIS?
' -opens an excel file with named cells, reads them from the specified sheet,
' then it will save this to another file. Basically this a template for
' generating reports from a large excel file that can be sent to people that only
' need minimal information
'microsoft tut
'http://support.microsoft.com/kb/302094
'also add COM Reference "Microsoft Excel Object Library 14"
' read a file already existing:
'http://vb.net-informations.com/excel-2007/vb.net_excel_2007_open_file.htm
'
' I have a file called accountInfo-ard-2012.xlsx
' it has named fields called:
' 'sumCash', 'weeklyPay'
' to start, lets read these in and display them
'
Option Strict Off
Imports Microsoft.Office.Interop
Public Class Form1
Const PRESET_RES_1 As String = "sumCash"
Const PRESET_RES_2 As String = "weeklyPay"
Dim strFileOpenPath As String = ""
Dim strFileSavePath As String = ""
'DEFAULTS:
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
txtRes1.Text = PRESET_RES_1
txtRes2.Text = PRESET_RES_2
txtSheetNameOpened.Text = "Sheet1"
chkRes1.Checked = True
chkRes2.Checked = True
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
'check that we have some file paths set
If Not (strFileOpenPath.Length > 5 And strFileSavePath.Length > 5 And txtSheetNameOpened.Text.Length > 1) Then
'end this event early
MessageBox.Show("You must select a file to open, to save, and a sheet name. ")
Return
End If
'all excel stuff:
Dim xlApp As Excel.Application
Dim xlWorkBook As Excel.Workbook
Dim xlWorkSheet As Excel.Worksheet
'Open Existing instance
xlApp = New Excel.Application()
xlWorkBook = xlApp.Workbooks.Open(strFileOpenPath) 'opens file selected
xlWorkSheet = xlWorkBook.Worksheets(txtSheetNameOpened.Text)
' later this should be a loop through a collection
Dim countChecked As Integer = 0
If chkRes1.Checked = True Then
countChecked += 1
End If
If chkRes2.Checked = True Then
countChecked += 1
End If
' MAIN LOGIC OF WRITING FILE
If countChecked >= 1 Then
'do stuff
Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object
'Start a new workbook in Excel
oExcel = CreateObject("Excel.Application")
oBook = oExcel.Workbooks.Add
oSheet = oBook.Worksheets(1)
If chkRes1.Checked = True Then
Dim strRes1 As String = txtRes1.Text
Dim strRes1Value As String = xlWorkSheet.Range(strRes1).Value
oSheet.Range("A2").Value = "Result 1:"
oSheet.Range("B2").Value = strRes1Value
End If
If chkRes2.Checked = True Then
Dim strRes2 As String = txtRes2.Text
Dim strRes2Value As String = xlWorkSheet.Range(strRes2).Value
oSheet.Range("A3").Value = "Result 2:"
oSheet.Range("B3").Value = strRes2Value
End If
'set a font
oSheet.Range("A1:A20").Font.Bold = True
'close the book
oBook.SaveAs(strFileSavePath)
oExcel.Quit()
Else
MessageBox.Show("No named cells were marked active...")
Return
End If
End Sub
'' ANOTHER WAY TO DO THIS, BY NAME:
'Dim strNames As String = ""
'Dim myNamed As Excel.Range
' Try
' myNamed = xlWorkSheet.Range("weeklyPay").Cells
' strNames = myNamed.Text
' MessageBox.Show("weekly Pay named cell: " + strNames)
' Catch ex As Exception
' MessageBox.Show("failed")
' End Try
'' GET BY COORDINATE:
'Dim strc11 As String = xlWorkSheet.Range("c11").Value
' MessageBox.Show("box c11 = " + strc11)
Private Sub btnOpenFile_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnOpenFile.Click
OpenFileDialog1.ShowDialog()
strFileOpenPath = OpenFileDialog1.FileName
lblFilePathOpen.Text = strFileOpenPath
End Sub
Private Sub btnSaveFile_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSaveFile.Click
SaveFileDialog1.Filter = "Excel Files: (*.xlsx)|*.xlsx"
SaveFileDialog1.ShowDialog()
strFileSavePath = SaveFileDialog1.FileName
lblFilePathClose.Text = strFileSavePath
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Me.Close()
End Sub
End Class
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment