private sub xlsout1_click() '匯出excel文件
if rs1.recordcount < 1 then
msgbox "匯出失敗，當前列表中沒有記錄!"
outstate1.visible = false
exit sub
end if
on error goto not_installexcel '當電腦沒裝excel軟體時的出錯處理
if msgbox(chr(13) + "是否將當前列表中的資料匯出為excel資料？ ", vbquestion + vbyesno) = vbno then exit sub
dim irow, icol as integer
dim irowcount, icolcount as integer
dim fieldlen() '存字段長度值
dim xlbook as excel.workbook
dim xlsheet as excel.worksheet
main.enabled = false
outstate1.visible = true '顯示匯出狀態
outstate1.caption = "正在匯出，請稍後..."
set xlsheet = xlbook.worksheets(1)
with rs1
.movelast
irowcount = .recordcount '記錄總數
icolcount = .fields.count '字段總數
redim fieldlen(icolcount)
.movefirst
'寫入標頭
xlsheet.rows(1).rowheight = 35
xlsheet.range(xlsheet.cells(1, 1), xlsheet.cells(1, rs1.fields.count)).mergecells = true
xlsheet.cells(1, 1).font.size = 14
xlsheet.cells(1, 1).font.bold = true
if usetype = "系統管理員" then
xlsheet.cells(1, 1).value = "課時津貼明細列表"
else
xlsheet.cells(1, 1).value = usepart & "課時津貼明細列表"
end if
'寫入記錄
for irow = 2 to irowcount + 2
for icol = 1 to icolcount
select case irow
case 2 '在excel中的第一行加標題
xlsheet.cells(irow, icol).value = .fields(icol - 1).name
case 3 '將陣列fieldlen()存為第一條記錄的字段長
if isnull(.fields(icol - 1)) = true then
fieldlen(icol) = lenb(.fields(icol - 1).name) '如果字段值為null,則將陣列filelen(icol)的值設為標題名的寬度
else
fieldlen(icol) = lenb(.fields(icol - 1))
end if
if fieldlen(icol) < lenb(.fields(icol - 1).name) then '如果字段值的長度小於標題名的寬度，則將陣列filelen(icol)的值設為標題名的寬度
fieldlen(icol) = lenb(.fields(icol - 1).name)
end if
xlsheet.columns(icol).columnwidth = fieldlen(icol) 'excel列寬等於字段長
xlsheet.cells(irow, icol).value = .fields(icol - 1) '向excel的cells中寫入字段值
case else
fieldlen1 = lenb(.fields(icol - 1))
if fieldlen(icol) < fieldlen1 then
xlsheet.columns(icol).columnwidth = fieldlen1 '**列寬等於較長字段長
fieldlen(icol) = fieldlen1 '陣列fieldlen(icol)中存放最大字段長度值
else
xlsheet.columns(icol).columnwidth = fieldlen(icol)
end if
xlsheet.cells(irow, icol).value = .fields(icol - 1)
end select
doevents
next icol
if irow > 2 then
if not .eof then .movenext
end if
doevents
outstate1.caption = "正在匯出，完成: " + cstr(int(100 * (irow - 2) / irowcount)) + "%" '顯示匯出進度
next irow
'新增年月日
xlsheet.cells(irowcount + 3, icolcount).value = format$(now, "yyyy年mm月dd日") '在最後一行後加是年月日
xlsheet.range(xlsheet.cells(irowcount + 3, 1), xlsheet.cells(irowcount + 3, icolcount)).mergecells = true '合併年月日所在的行
xlsheet.cells(irowcount + 3, 1).horizontalalignment = xlhalignright '設定為右對齊
with xlsheet
.range(.cells(2, 1), .cells(2, icol - 1)).font.bold = true '標題字型加粗
.range(.cells(1, 1), .cells(irow, icol - 1)).borders.linestyle = xlcontinuous '設**邊框樣式
.columns("a:i").verticalalignment = xlvaligncenter '垂直居中
.range(.cells(1, 1), .cells(irow - 1, icol - 1)).horizontalalignment = xlhaligncenter '水平居中對齊
end with
.movefirst
end with
outstate1.visible = false
main.enabled = true
exit sub
not_installexcel: '當電腦沒有裝excel軟體時的處理
msgbox "匯出錯誤！請檢查電腦是否裝有不低於excel2000版本的excel軟體！" & chr(13) & chr(10) & "然後檢查一下出錯處的記錄是否有問題！"
outstate1.visible = false
main.enabled = true
end sub
畢業設計！畢業設計！！畢業設計！！！
看到ceocio的帖子 嚇人哦 深有體會。進幾年有些本科學生的程式與 實在不象話。有的組的答辯問題簡直成了挑錯字，平均每頁都有錯字。有的組在資料庫設計時，姓名 身份證號 手機號 日期全部都用char 10 答辯時還振振有辭，說在做測試時僅僅輸入了些簡單的數字做測試，所以沒有發現問題！還有的學生 是這...
製作畢業設計
1.本工作室有豐富的 asp 和 asp.net開發經驗,歡迎廣大2008屆畢業生朋友前來諮詢.2.注意 本工作室只做設計,不做 但是我會將設計的要點難點和設計思路用word寫出來,這樣保證畢業生朋友能明白我的設計思想.確保答辨過關,當然必要時可以指導畢業生進行 的寫作.3.定做乙個畢業設計的 一般...
畢業設計（四）
畢業設計 四 一如既往，先說說兩天來的感悟吧 1.如果以前我說xml是個好東西，都是人家告訴我的，今天我終於在設計 的時候在xml上收到巨大的好處啊 只要把網頁做成乙個個小的xml直譯器，就可以把資源整合到最大的程度，同時也分離到最大的程度 以後一切的修改更新盡在xml中，真是perfect之至阿 ...