Use excel in VB

Private sub cmdswatch_click ()
Dim XLS as Excel. Application
Dim xlbook as Excel. Workbook
'On error goto exlerror
Dim I as integer
If Dir (text1.text) <> "" then': if a file with the same name is displayed in this directory, handle it accordingly.
If msgbox ("the file already exists, overwrite it or not! ", Vbyesno + vbquestion," Save As project cost file ") = vbno then
Exit sub
Else
Kill (text1.text) 'deletes an object
End if
End if

* Open a worksheet ***************
Set XLS = new excel. Application
XLS. Visible = true
Set xlbook = XLS. workbooks. Add
'*********************************
For I = 0 to 14
If check2 (I). value = vbchecked then
Select case I
Case 8
Toexceljdanjiasum. toexceljdanjiasum xlbook, xls
Case 9
Toexceladanjiasum. toexceladanjiasum xlbook, xls
Case 10
Toexcelcailiao. toexcelcailiao xlbook, xls
Case 11
Toexceltsf. toexceltsf xlbook, xls
Case 12
Toexcelzgcl. toexcelzgcl xlbook, xls
End select
End if
Next
For I = 0 to 6
If check3 (I). value = vbchecked then
Select case I
Case 0
Toexcelman. toexcelman xlbook, xls
Case 1
Toexcelfsd_cl.toexcelfsd_cl xlbook, xls
Case 2
Toexcelhnt. toexcelhnt xlbook, xls
Case 3
Toexcelzsf. toexcelzsf xlbook, xls
Case 4
Toexceljingchang. toexceljingchang xlbook, xls
Case 5
Toexceljdanjia. toexceljdanjia xlbook, xls
Case 6
Toexceladanjia. toexceladanjia xlbook, xls
End select
End if
Next

Xlbook. saveas text1.text 'Save the Excel file
********* **********
If check1.value = vbchecked then
Xlbook. Close
XLS. Quit
End if
Set xlbook = nothing
Set XLS = nothing
Exit sub
'Lerror:
'Msgbox err. Description, vbokonly + vbcritical, "warning"
End sub

Option explicit
Public sub toexcelzgcl (byref xlbook, byref XLS) 'total output volume
Dim con as new ADODB. Connection
Dim rst_gcl as new ADODB. recordset
Dim rst_qm as new ADODB. recordset
*********** *****************************
Con. cursorlocation = aduseclient
Con. connectionstring = "provider = Microsoft. Jet. oledb.4.0; Data Source =" & strconnection & "; persist Security info = false"
Con. Open
Rst_gcl.open "zonggcl", Con, adopenkeyset, adlockoptimistic, adcmdtable 'Open the engineering quantity summary table
If not (rst_gcl.bof and rst_gcl.eof) then
Rst_gcl.movefirst
End if
Rst_qm.open "qianming", Con, adopenkeyset, adlockoptimistic, adcmdtable 'Open the signature table
Rst_qm.movefirst
******* ****************************
Dim xlsheet as Excel. Worksheet
Set xlsheet = xlbook. Sheets. add' Add a worksheet
Xlsheet. Name = "engineering quantity summary"
XLS. activesheet. pagesetup. Orientation = xllandscape
Xlsheet. Columns ("A: J"). Font. size = 10
Xlsheet. Columns ("A: J"). verticalalignment = xlvaligncenter vertical center
Xlsheet. Columns (1). horizontalalignment = xlhaligncenter column 1 horizontal center alignment
Xlsheet. Columns (1). columnwidth = 8
Xlsheet. columns (2). horizontalalignment = xlhalignleft
Xlsheet. columns (2). columnwidth = 26
Xlsheet. Columns ("C: J"). horizontalalignment = xlhalignright
Xlsheet. Columns ("C: J"). columnwidth = 10
Xlsheet. Columns ("C: J"). numberformatlocal = "0.00 _" '3 to 10 columns retain two decimal places
********** ***************************
Xlsheet. Rows (1). rowheight = 40
Xlsheet. Range (xlsheet. cells (1, 1), xlsheet. cells (1, 10). mergecells = true
Xlsheet. cells (1, 1). value = "engineering quantity summary"
Xlsheet. cells (1, 1). Font. size = 14
Xlsheet. cells (1, 1). Font. Bold = true

Xlsheet. Rows (2). rowheight = 18
Xlsheet. Rows (2). horizontalalignment = xlhaligncenter
Xlsheet. cells (2, 1). value = "no"
Xlsheet. cells (2, 2). value = "project and name"
Xlsheet. cells (2, 3). value = "earthwork excavation (m3 )"
Xlsheet. cells (2, 4). value = "Stone excavation (m3 )"
Xlsheet. cells (2, 5). value = "earthwork backfilling (m3 )"
Xlsheet. cells (2, 6). value = "m3 )"
Xlsheet. cells (2, 7). value = "Concrete Pouring (m3 )"
Xlsheet. cells (2, 8). value = "reinforced security (t )"
Xlsheet. cells (2, 9). value = "masonry Engineering (m3 )"
Xlsheet. cells (2, 10). value = "grouting (m )"

XLS. activesheet. pagesetup. printtitlerows = "$1: $2" 'fixed Header
********** ***************
Dim I as integer
I = 3' I control row
Dim J as integer 'J control column
Dim countpage as integer
Countpage = 0' control page
Do while not rst_gcl.eof
Xlsheet. Rows (I). rowheight = 18 'control Row Height
For j = 1 to 10
Xlsheet. cells (I, j) = rst_gcl.fields (j) 'writes the first field of a record in the Engineering Library to the worksheet.
Next
'Every 18 actions are one page. If the data exceeds one page, special processing is performed.
If I> 18 then
XLS. activewindow. smallscroll down: = 1' the content of the activity window is scrolled down by one row.
End if
If I mod 18 = 0 then
If countpage = 0 then
Xlsheet. Range (xlsheet. cells (2, 1), xlsheet. cells (I, 10). Borders. linestyle = xlcontinuous
Else
Xlsheet. range (xlsheet. cells (23 + (countpage-1) * 18, 1), xlsheet. cells (I, 10 )). borders. linestyle = xlcontinuous add borders to the middle page
End if
I = I + 2' add an empty line

* Write a signature on a non-ending page *** ***********************************
Xlsheet. Range (xlsheet. cells (I, 1), xlsheet. cells (I, 10). mergecells = true
Xlsheet. cells (I, 1). value = space (64) & rst_qm.fields (0)
Xlsheet. Rows (I). rowheight = 30
I = I + 1' line feed
Xlsheet. Range (xlsheet. cells (I, 1), xlsheet. cells (I, 10). mergecells = true
Xlsheet. cells (I, 1). value = space (50) & rst_qm.fields (1)
Xlsheet. Rows (I). rowheight = 15
I = I + 1
Xlsheet. Range (xlsheet. cells (I, 1), xlsheet. cells (I, 10). mergecells = true
Xlsheet. cells (I, 1). value = space (55) & rst_qm.fields (2)
Xlsheet. Rows (I). rowheight = 30
'*************************************** *************************************

Xlsheet. hpagebreaks. Add (xlsheet. Rows (I + 1) 'Add a paging character
Countpage = countpage + 1' form feed
End if
I = I + 1
Rst_gcl.movenext
Loop
Xlsheet. range (xlsheet. cells (23 + (countpage-1) * 18, 1), xlsheet. cells (I-1, 10 )). borders. linestyle = xlcontinuous Add a border at the end of the page
I = I + 1' add an empty row
* Add a signature to the end of the page * **************************************
Xlsheet. Range (xlsheet. cells (I, 1), xlsheet. cells (I, 10). mergecells = true
Xlsheet. cells (I, 1). value = space (64) & rst_qm.fields (0)
Xlsheet. Rows (I). rowheight = 30
I = I + 1' line feed
Xlsheet. Range (xlsheet. cells (I, 1), xlsheet. cells (I, 10). mergecells = true
Xlsheet. cells (I, 1). value = space (50) & rst_qm.fields (1)
Xlsheet. Rows (I). rowheight = 15
I = I + 1
Xlsheet. Range (xlsheet. cells (I, 1), xlsheet. cells (I, 10). mergecells = true
Xlsheet. cells (I, 1). value = space (55) & rst_qm.fields (2)
Xlsheet. Rows (I). rowheight = 30
'*************************************** **************************************** ****
XLS. activewindow. view = xlpagebreakpreview
XLS. activewindow. Zoom = 100

If con. State = adstateopen then
Rst_gcl.close
Rst_qm.close
Set rst_gcl = nothing
Set rst_qm = nothing
Con. Close
Set con = nothing
End if
Set xlsheet = nothing
End sub

 

Option explicit

Public sub toexceltsf (byref xlbook, byref XLS)
Dim con as new ADODB. Connection
Dim rst_tsf as new ADODB. recordset
Dim rst_qm as new ADODB. recordset
*** *********************
Con. cursorlocation = aduseclient
Con. connectionstring = "provider = Microsoft. Jet. oledb.4.0; Data Source =" & strconnection & "; persist Security info = false"
Con. Open
Rst_tsf.open "tdefeiyong", Con, adopenkeyset, adlockoptimistic, adcmdtable
If not (rst_tsf.bof and rst_tsf.eof) then
Rst_tsf.movefirst
End if
Rst_qm.open "qianming", Con, adopenkeyset, adlockoptimistic, adcmdtable
Rst_qm.movefirst
** ********************************
Dim xlsheet as Excel. Worksheet
Set xlsheet = xlbook. Sheets. Add
Xlsheet. Name = "instance time and group time fee summary table"
Xlsheet. Columns (1). columnwidth = 5
Xlsheet. columns (2). columnwidth = 20
Xlsheet. Columns (3). columnwidth = 7
Xlsheet. Columns (4). columnwidth = 7
Xlsheet. Columns (5). columnwidth = 7
Xlsheet. columns (6). columnwidth = 7
Xlsheet. Columns (7). columnwidth = 7
Xlsheet. Columns (8). columnwidth = 7
Xlsheet. Columns (9). columnwidth = 7
Xlsheet. Columns ("A: I"). Font. size = 9
Xlsheet. Columns ("A: I"). verticalalignment = xlvaligncenter vertical center
Xlsheet. Columns (1). horizontalalignment = xlhaligncenter column 1 horizontal center alignment
Xlsheet. columns (2). horizontalalignment = xlhalignleft '2 horizontal left alignment
******* *****************************
Xlsheet. Rows (1). rowheight = 35
Xlsheet. Range (xlsheet. cells (1, 1), xlsheet. cells (1, 9). mergecells = true
Xlsheet. cells (1, 1). Font. size = 14
Xlsheet. cells (1, 1). Font. Bold = true
Xlsheet. cells (1, 1). value = "Summary table of unit time and group time fee"

Xlsheet. cells (2, 9). value = "unit: Yuan"
Xlsheet. Range (xlsheet. cells (3, 1), xlsheet. cells (5, 1). mergecells = true
Xlsheet. cells (3, 1). value = "no"
Xlsheet. Range (xlsheet. cells (3, 2), xlsheet. cells (5, 2). mergecells = true
Xlsheet. cells (3, 2). value = "mechanical name"
Xlsheet. Range (xlsheet. cells (3, 3), xlsheet. cells (5, 3). mergecells = true
Xlsheet. cells (3, 3). value = "pay-as-you-go"
Xlsheet. Range (xlsheet. cells (3, 4), xlsheet. cells (3, 9). mergecells = true
Xlsheet. cells (3, 4). value = "in it"
Xlsheet. Range (xlsheet. cells (3, 3), xlsheet. cells (5, 3). mergecells = true
Xlsheet. cells (3, 3). value = "pay-as-you-go"
Xlsheet. Range (xlsheet. cells (4, 4), xlsheet. cells (5, 4). mergecells = true
Xlsheet. cells (4, 4). value = "Depreciation"
Xlsheet. Range (xlsheet. cells (4, 5), xlsheet. cells (5, 5). mergecells = true
Xlsheet. cells (4, 5). value = "repair and replacement fee"
Xlsheet. Range (xlsheet. cells (4, 6), xlsheet. cells (5, 6). mergecells = true
Xlsheet. cells (4, 6). value = "Demolition fee"
Xlsheet. Range (xlsheet. cells (4, 7), xlsheet. cells (5, 7). mergecells = true
Xlsheet. cells (4, 7). value = "labor fee"
Xlsheet. Range (xlsheet. cells (4, 8), xlsheet. cells (5, 8). mergecells = true
Xlsheet. cells (4, 8). value = "fuel fee"
Xlsheet. Range (xlsheet. cells (4, 9), xlsheet. cells (5, 9). mergecells = true
Xlsheet. cells (4, 9). value = "other fees"

Xlsheet. Range (xlsheet. cells (1, 1), xlsheet. cells (5, 9). horizontalalignment = xlhaligncenter
XLS. activesheet. pagesetup. printtitlerows = "$1: $5" 'fixed Header
'*************************************** * Write content *************************************
Dim I as integer
I = 6
Do while not rst_tsf.eof
Xlsheet. cells (I, 1). value = rst_tsf.fields ("Nn ")
Xlsheet. cells (I, 2). value = rst_tsf.fields ("name ")
Xlsheet. cells (I, 3). value = rst_tsf.fields ("price ")
Xlsheet. cells (I, 4). value = rst_tsf.fields ("zhejiu ")
Xlsheet. cells (I, 5). value = rst_tsf.fields ("xiuli ")
Xlsheet. cells (I, 6). value = rst_tsf.fields ("anchai ")
Xlsheet. cells (I, 7). value = rst_tsf.fields ("rengong ")
Xlsheet. cells (I, 8). value = rst_tsf.fields ("dongli ")
Xlsheet. cells (I, 9). value = rst_tsf.fields ("qita ")
If I> 22 then
XLS. activewindow. smallscroll down: = 1' the content of the activity window is scrolled down by one row.
End if
I = I + 1
Rst_tsf.movenext
Loop
Xlsheet. Range (xlsheet. cells (6, 3), xlsheet. cells (I-1, 9). numberformatlocal = "0.00 _" 'retain two decimal places

**** ******************************
Xlsheet. Range (xlsheet. cells (3, 1), xlsheet. cells (I-1, 9). Borders. linestyle = xlcontinuous
'*************************************** ***************************************
XLS. activesheet. pagesetup. bottommargin = application. inchestopoints (2.2) 'sets the bottom side margin
XLS. activesheet. pagesetup. footermargin = application. inchestopoints (1) 'sets the footer height.
XLS. activesheet. pagesetup. centerfooter = "& 10" & rst_qm.fields (0) & CHR (10) & CHR (10) & rst_qm.fields (1) & CHR (10) & CHR (10) & rst_qm.fields (2) 'add footer
XLS. activewindow. view = xlpagebreakpreview
XLS. activewindow. Zoom = 100
********* **********
If con. State = adstateopen then
Rst_tsf.close
Rst_qm.close
Set rst_tsf = nothing
Set rst_qm = nothing
Con. Close
Set con = nothing
End if
Set xlsheet = nothing
End sub