asp操作Excel類_易賢網(wǎng)

當(dāng)前位置：首頁 > 范文|應(yīng)用文 > IT技術(shù)專欄 > 網(wǎng)絡(luò)編程

asp操作Excel類

來源：易賢網(wǎng) 閱讀：2695 次日期：2014-09-10 17:47:10

溫馨提示：易賢網(wǎng)小編為您整理了“asp操作Excel類”,方便廣大網(wǎng)友查閱！

asp操作Excel類：

< %

'*******************************************************************

'使用說明

'Dim a

'Set a=new CreateExcel

'a.SavePath="x" '保存路徑

'a.SheetName="工作簿名稱" '多個工作表 a.SheetName=array("工作簿名稱一","工作簿名稱二")

'a.SheetTitle="表名稱" '可以為空多個工作表 a.SheetName=array("表名稱一","表名稱二")

'a.Data =d '二維數(shù)組 '多個工作表 array(b,c) b與c為二維數(shù)組

'Dim rs

'Set rs=server.CreateObject("Adodb.RecordSet")

'rs.open "Select id, classid, className from [class] ",conn, 1, 1

'a.AddDBData rs, "字段名一，字段名二", "工作簿名稱", "表名稱", true 'true自動獲取表字段名

'a.AddData c, true , "工作簿名稱", "表名稱" 'c二維數(shù)組 true 第一行是否為標(biāo)題行

'a.AddtData e, "Sheet1" '按模板生成 c=array(array("AA1", "內(nèi)容"), array("AA2", "內(nèi)容2"))

'a.Create()

'a.UsedTime 生成時間，毫秒數(shù)

'a.SavePath 保存路徑

'Set a=nothing

'設(shè)置COM組件的操作權(quán)限。在命令行鍵入“DCOMCNFG”，則進入COM組件配置界面，選擇MicrosoftExcel后點擊屬性按鈕，將三個單選項一律選擇自定義，編輯中將Everyone加入所有權(quán)限

'*******************************************************************

Class CreateExcel

Private CreateType_

Private savePath_

Private readPath_

Private AuthorStr Rem 設(shè)置作者

Private VersionStr Rem 設(shè)置版本

Private SystemStr Rem 設(shè)置系統(tǒng)名稱

Private SheetName_ Rem 設(shè)置表名

Private SheetTitle_ Rem 設(shè)置標(biāo)題

Private ExcelData Rem 設(shè)置表數(shù)據(jù)

Private ExcelApp Rem Excel.Application

Private ExcelBook

Private ExcelSheets

Private UsedTime_ Rem 使用的時間

Public TitleFirstLine Rem 首行是否標(biāo)題

Private Sub Class_Initialize()

Server.ScriptTimeOut = 99999

UsedTime_ = Timer

SystemStr = "Lc00_CreateExcelServer"

AuthorStr = "Surnfu surnfu@126.com 31333716"

VersionStr = "1.0"

if not IsObjInstalled("Excel.Application") then

InErr("服務(wù)器未安裝Excel.Application控件")

end if

set ExcelApp = createObject("Excel.Application")

ExcelApp.DisplayAlerts = false

ExcelApp.Application.Visible = false

CreateType_ = 1

readPath_ = null

End Sub

Private Sub Class_Terminate()

ExcelApp.Quit

If Isobject(ExcelSheets) Then Set ExcelSheets = Nothing

If Isobject(ExcelBook) Then Set ExcelBook = Nothing

If Isobject(ExcelApp) Then Set ExcelApp = Nothing

End Sub

Public Property Let ReadPath(ByVal Val)

If Instr(Val, ":\")<>0 Then

readPath_ = Trim(Val)

else

readPath_=Server.MapPath(Trim(Val))

end if

End Property

Public Property Let SavePath(ByVal Val)

If Instr(Val, ":\")<>0 Then

savePath_ = Trim(Val)

else

savePath_=Server.MapPath(Trim(Val))

end if

End Property

Public Property Let CreateType(ByVal Val)

if Val <> 1 and Val <> 2 then

CreateType_ = 1

else

CreateType_ = Val

end if

End Property

Public Property Let Data(ByVal Val)

if not isArray(Val) then

InErr("表數(shù)據(jù)設(shè)置有誤")

end if

ExcelData = Val

End Property

Public Property Get SavePath()

SavePath = savePath_

End Property

Public Property Get UsedTime()

UsedTime = UsedTime_

End Property

Public Property Let SheetName(ByVal Val)

if not isArray(Val) then

if Val = "" then

InErr("表名設(shè)置有誤")

end if

TitleFirstLine = true

else

ReDim TitleFirstLine(Ubound(Val))

Dim ik_

For ik_ = 0 to Ubound(Val)

TitleFirstLine(ik_) = true

end if

SheetName_ = Val

End Property

Public Property Let SheetTitle(ByVal Val)

if not isArray(Val) then

if Val = "" then

InErr("表標(biāo)題設(shè)置有誤")

end if

SheetTitle_ = Val

End Property

Rem 檢查數(shù)據(jù)

Private Sub CheckData()

if savePath_ = "" then InErr("保存路徑不能為空")

if not isArray(SheetName_) then

if SheetName_ = "" then InErr("表名不能為空")

end if

if CreateType_ = 2 then

if not isArray(ExcelData) then

InErr("數(shù)據(jù)載入錯誤，或者未載入")

end if

Exit Sub

end if

if isArray(SheetName_) then

if not isArray(SheetTitle_) then

if SheetTitle_ <> "" then InErr("表標(biāo)題設(shè)置有誤，與表名不對應(yīng)")

end if

if not IsArray(ExcelData) then

InErr("表數(shù)據(jù)載入有誤")

end if

if isArray(SheetName_) then

if GetArrayDim(ExcelData) <> 1 then InErr("表數(shù)據(jù)載入有誤，數(shù)據(jù)格式錯誤，維度應(yīng)該為一")

else

if GetArrayDim(ExcelData) <> 2 then InErr("表數(shù)據(jù)載入有誤，數(shù)據(jù)格式錯誤，維度應(yīng)該為二")

end if

End Sub

Rem 生成Excel

Public Function Create()

Call CheckData()

if not isnull(readPath_) then

ExcelApp.WorkBooks.Open(readPath_)

else

ExcelApp.WorkBooks.add

end if

set ExcelBook = ExcelApp.ActiveWorkBook

set ExcelSheets = ExcelBook.Worksheets

if CreateType_ = 2 then

Dim ih_

For ih_ = 0 to Ubound(ExcelData)

Call SetSheets(ExcelData(ih_), ih_)

ExcelBook.SaveAs savePath_

UsedTime_ = FormatNumber((Timer - UsedTime_)*1000, 3)

Exit Function

end if

if IsArray(SheetName_) then

Dim ik_

For ik_ = 0 to Ubound(ExcelData)

Call CreateSheets(ExcelData(ik_), ik_)

else

Call CreateSheets(ExcelData, -1)

end if

ExcelBook.SaveAs savePath_

UsedTime_ = FormatNumber((Timer - UsedTime_)*1000, 3)

End Function

Private Sub CreateSheets(ByVal Data_, DataId_)

Dim Spreadsheet

Dim tempSheetTitle

Dim tempTitleFirstLine

if DataId_<>-1 then

if DataId_ > ExcelSheets.Count - 1 then

ExcelSheets.Add()

set Spreadsheet = ExcelBook.Sheets(1)

else

set Spreadsheet = ExcelBook.Sheets(DataId_ + 1)

end if

if isArray(SheetTitle_) then

tempSheetTitle = SheetTitle_(DataId_)

else

tempSheetTitle = ""

end if

tempTitleFirstLine = TitleFirstLine(DataId_)

Spreadsheet.Name = SheetName_(DataId_)

else

set Spreadsheet = ExcelBook.Sheets(1)

Spreadsheet.Name = SheetName_

tempSheetTitle = SheetTitle_

tempTitleFirstLine = TitleFirstLine

end if

Dim Line_ : Line_ = 1

Dim RowNum_ : RowNum_ = Ubound(Data_, 1) + 1

Dim LastCols_

if tempSheetTitle <> "" then

'Spreadsheet.Columns(1).ShrinkToFit=true '設(shè)定是否自動適應(yīng)表格單元大小(單元格寬不變）

LastCols_ = getColName(Ubound(Data_, 2) + 1)

with Spreadsheet.Cells(1, 1)

.value = tempSheetTitle

'設(shè)置Excel表里的字體

.Font.Bold = True '單元格字體加粗

.Font.Italic = False '單元格字體傾斜

.Font.Size = 20 '設(shè)置單元格字號

.font.name="宋體" '設(shè)置單元格字體

'.font.ColorIndex=2 '設(shè)置單元格文字的顏色，顏色可以查詢，2為白色

End with

with Spreadsheet.Range("A1:"& LastCols_ &"1")

.merge '合并單元格(單元區(qū)域)

'.Interior.ColorIndex = 1 '設(shè)計單元絡(luò)背景色

.HorizontalAlignment = 3 '居中

End with

Line_ = 2

RowNum_ = RowNum_ + 1

end if

Dim iRow_, iCol_

Dim dRow_, dCol_

Dim tempLastRange : tempLastRange = getColName(Ubound(Data_, 2)+1) & (RowNum_)

Dim BeginRow : BeginRow = 1

if tempSheetTitle <> "" then BeginRow = BeginRow + 1

if tempTitleFirstLine = true then BeginRow = BeginRow + 1

if BeginRow=1 then

with Spreadsheet.Range("A1:"& tempLastRange)

.Borders.LineStyle = 1

.BorderAround -4119, -4138 '設(shè)置外框

.NumberFormatLocal = "@" '文本格式

.Font.Bold = False

.Font.Italic = False

.Font.Size = 10

.ShrinkToFit=true

end with

else

with Spreadsheet.Range("A1:"& tempLastRange)

.Borders.LineStyle = 1

.BorderAround -4119, -4138

.ShrinkToFit=true

end with

with Spreadsheet.Range("A"& BeginRow &":"& tempLastRange)

.NumberFormatLocal = "@"

.Font.Bold = False

.Font.Italic = False

.Font.Size = 10

end with

end if

if tempTitleFirstLine = true then

BeginRow = 1

if tempSheetTitle <> "" then BeginRow = BeginRow + 1

with Spreadsheet.Range("A"& BeginRow &":"& getColName(Ubound(Data_, 2)+1) & (BeginRow))

.NumberFormatLocal = "@"

.Font.Bold = True

.Font.Italic = False

.Font.Size = 12

.Interior.ColorIndex = 37

.HorizontalAlignment = 3 '居中

.font.ColorIndex=2

end with

end if

For iRow_ = Line_ To RowNum_

For iCol_ = 1 To (Ubound(Data_, 2) + 1)

dCol_ = iCol_ - 1

if tempSheetTitle <> "" then dRow_ = iRow_ - 2 else dRow_ = iRow_ - 1

If not IsNull(Data_(dRow_, dCol_)) then

with Spreadsheet.Cells(iRow_, iCol_)

.Value = Data_(dRow_, dCol_)

End with

End If

set Spreadsheet = Nothing

End Sub

Rem 測試組件是否已經(jīng)安裝

Private Function IsObjInstalled(strClassString)

On Error Resume Next

IsObjInstalled = False

Err = 0

Dim xTestObj

Set xTestObj = Server.CreateObject(strClassString)

If 0 = Err Then IsObjInstalled = True

Set xTestObj = Nothing

Err = 0

End Function

Rem 取得數(shù)組維數(shù)

Private Function GetArrayDim(ByVal arr)

GetArrayDim = Null

Dim i_, temp

If IsArray(arr) Then

For i_ = 1 To 60

On Error Resume Next

temp = UBound(arr, i_)

If Err.Number <> 0 Then

GetArrayDim = i_ - 1

Err.Clear

Exit Function

End If

GetArrayDim = i_

End If

End Function

Private Function GetNumFormatLocal(DataType)

Select Case DataType

Case "Currency":

GetNumFormatLocal = "￥#,##0.00_);(￥#,##0.00)"

Case "Time":

GetNumFormatLocal = "[$-F800]dddd, mmmm dd, yyyy"

Case "Char":

GetNumFormatLocal = "@"

Case "Common":

GetNumFormatLocal = "G/通用格式"

Case "Number":

GetNumFormatLocal = "#,##0.00_"

Case else :

GetNumFormatLocal = "@"

End Select

End Function

Public Sub AddDBData(ByVal RsFlied, ByVal FliedTitle, ByVal tempSheetName_, ByVal tempSheetTitle_, DBTitle)

if RsFlied.Eof then Exit Sub

Dim colNum_ : colNum_ = RsFlied.fields.count

Dim Rownum_ : Rownum_ = RsFlied.RecordCount

Dim ArrFliedTitle

if DBTitle = true then

FliedTitle = ""

Dim ig_

For ig_=0 to colNum_ - 1

FliedTitle = FliedTitle & RsFlied.fields.item(ig_).name

if ig_ <> colNum_ - 1 then FliedTitle = FliedTitle &","

end if

if FliedTitle<>"" then

Rownum_ = Rownum_ + 1

ArrFliedTitle = Split(FliedTitle, ",")

if Ubound(ArrFliedTitle) <> colNum_ - 1 then

InErr("獲取數(shù)據(jù)庫表有誤，列數(shù)不符")

end if

Dim tempData : ReDim tempData(Rownum_ - 1, colNum_ - 1)

Dim ix_, iy_

Dim iz

if FliedTitle<>"" then iz = Rownum_ - 2 else iz = Rownum_ - 1

For ix_ = 0 To iz

For iy_ = 0 To colNum_ - 1

if FliedTitle<>"" then

if ix_=0 then

tempData(ix_, iy_) = ArrFliedTitle(iy_)

tempData(ix_ + 1, iy_) = RsFlied(iy_)

else

tempData(ix_ + 1, iy_) = RsFlied(iy_)

end if

else

tempData(ix_, iy_) = RsFlied(iy_)

end if

RsFlied.MoveNext

Dim tempFirstLine

if FliedTitle<>"" then tempFirstLine = true else tempFirstLine = false

Call AddData(tempData, tempFirstLine, tempSheetName_, tempSheetTitle_)

End Sub

Public Sub AddData(ByVal tempDate_, ByVal tempFirstLine_, ByVal tempSheetName_, ByVal tempSheetTitle_)

if not isArray(ExcelData) then

ExcelData = tempDate_

TitleFirstLine = tempFirstLine_

SheetName_ = tempSheetName_

SheetTitle_ = tempSheetTitle_

else

if GetArrayDim(ExcelData) = 1 then

Dim tempArrLen : tempArrLen = Ubound(ExcelData)+1

ReDim Preserve ExcelData(tempArrLen)

ExcelData(tempArrLen) = tempDate_

ReDim Preserve TitleFirstLine(tempArrLen)

TitleFirstLine(tempArrLen) = tempFirstLine_

ReDim Preserve SheetName_(tempArrLen)

SheetName_(tempArrLen) = tempSheetName_

ReDim Preserve SheetTitle_(tempArrLen)

SheetTitle_(tempArrLen) = tempSheetTitle_

else

Dim tempOldData : tempOldData = ExcelData

ExcelData = Array(tempOldData, tempDate_)

TitleFirstLine = Array(TitleFirstLine, tempFirstLine_)

SheetName_ = Array(SheetName_, tempSheetName_)

SheetTitle_ = Array(SheetTitle_, tempSheetTitle_)

end if

End Sub

Rem 模板增加數(shù)據(jù)方法

Public Sub AddtData(ByVal tempDate_, ByVal tempSheetName_)

CreateType_ = 2

if not isArray(ExcelData) then

ExcelData = Array(tempDate_)

SheetName_ = Array(tempSheetName_)

else

Dim tempArrLen : tempArrLen = Ubound(ExcelData)+1

ReDim Preserve ExcelData(tempArrLen)

ExcelData(tempArrLen) = tempDate_

ReDim Preserve SheetName_(tempArrLen)

SheetName_(tempArrLen) = tempSheetName_

End if

End Sub

Private Sub SetSheets(ByVal Data_, DataId_)

Dim Spreadsheet

set Spreadsheet = ExcelBook.Sheets(SheetName_(DataId_))

Spreadsheet.Activate

Dim ix_

For ix_ =0 To Ubound(Data_)

if not isArray(Data_(ix_)) then InErr("表數(shù)據(jù)載入有誤，數(shù)據(jù)格式錯誤")

if Ubound(Data_(ix_)) <> 1 then InErr("表數(shù)據(jù)載入有誤，數(shù)據(jù)格式錯誤")

Spreadsheet.Range(Data_(ix_)(0)).value = Data_(ix_)(1)

set Spreadsheet = Nothing

End Sub

Public Function GetTime(msec_)

Dim ReTime_ : ReTime_=""

if msec_ < 1000 then

ReTime_ = msec_ &"MS"

else

Dim second_

second_ = (msec_ \ 1000)

if (msec_ mod 1000)<>0 then

msec_ = (msec_ mod 1000) &"毫秒"

else

msec_ = ""

end if

Dim n_, aryTime(2), aryTimeunit(2)

aryTimeunit(0) = "秒"

aryTimeunit(1) = "分"

aryTimeunit(2) = "小時"

n_ = 0

Dim tempSecond_ : tempSecond_ = second_

While(tempSecond_ / 60 >= 1)

tempSecond_ = Fix(tempSecond_ / 60 * 100) / 100

n_ = n_ + 1

WEnd

Dim m_

For m_ = n_ To 0 Step -1

aryTime(m_) = second_ \ (60 ^ m_)

second_ = second_ mod (60 ^ m_)

ReTime_ = ReTime_ & aryTime(m_) & aryTimeunit(m_)

if msec_<>"" then ReTime_ = ReTime_ & msec_

end if

GetTime = ReTime_

end Function

Rem 取得列名

Private Function getColName(ByVal ColNum)

Dim Arrlitter : Arrlitter=split("A B C D E F G H I J K L M N O P Q R S T U V W X Y Z", " ")

Dim ReValue_

if ColNum <= Ubound(Arrlitter) + 1 then

ReValue_ = Arrlitter(ColNum - 1)

else

ReValue_ = Arrlitter(((ColNum-1) \ 26)) & Arrlitter(((ColNum-1) mod 26))

end if

getColName = ReValue_

End Function

Rem 設(shè)置錯誤

Private Sub InErr(ErrInfo)

Err.Raise vbObjectError + 1, SystemStr &"(Version "& VersionStr &")", ErrInfo

End Sub

End Class

Dim b(4,6)

Dim c(50,20)

Dim i, j

For i=0 to 4

For j=0 to 6

b(i,j) =i&"-"&j

For i=0 to 50

For j=0 to 20

c(i,j) = i&"-"&j &"我的"

Dim e(20)

For i=0 to 20

e(i)= array("A"&(i+1), i+1)

'使用示例需要xx.xls模板支持

'Set a=new CreateExcel

'a.ReadPath = "xx.xls"

'a.SavePath="xx-1.xls"

'a.AddtData e, "Sheet1"

'a.Create()

'response.Write("生成"& a.SavePath &"　使用了 "& a.GetTime(a.UsedTime) &"

'Set a=nothing

'使用示例一

Set a=new CreateExcel

a.SavePath="x.xls"

a.AddData b, true , "測試c", "測試c"

a.TitleFirstLine = false '首行是否為標(biāo)題行

a.Create()

response.Write("生成"& a.SavePath &"　使用了 "& a.GetTime(a.UsedTime) &"

Set a=nothing

'使用示例二

Set a=new CreateExcel

a.SavePath="y.xls"

a.SheetName="工作簿名稱" '多個工作表 a.SheetName=array("工作簿名稱一","工作簿名稱二")

a.SheetTitle="表名稱" '可以為空多個工作表 a.SheetName=array("表名稱一","表名稱二")

a.Data =b '二維數(shù)組 '多個工作表 array(b,c) b與c為二維數(shù)組

a.Create()

response.Write("生成"& a.SavePath &"　使用了 "& a.GetTime(a.UsedTime) &"

Set a=nothing

'使用示例三生成兩個表

Set a=new CreateExcel

a.SavePath="z.xls"

a.SheetName=array("工作簿名稱一","工作簿名稱二")

a.SheetTitle=array("表名稱一","表名稱二")

a.Data =array(b, c) 'b與c為二維數(shù)組

a.TitleFirstLine = array(false, true) '首行是否為標(biāo)題行

a.Create()

response.Write("生成"& a.SavePath &"　使用了 "& a.GetTime(a.UsedTime) &"

Set a=nothing

'使用示例四需要數(shù)據(jù)庫支持

'Dim rs

'Set rs=server.CreateObject("Adodb.RecordSet")

'rs.open "Select id, classid, className from [class] ",conn, 1, 1

'Set a=new CreateExcel

'a.SavePath="a"

'a.AddDBData rs, "序號,類別序號,類別名稱", "工作簿名稱", "類別表", false

'a.Create()

'response.Write("生成"& a.SavePath &"　使用了 "& a.GetTime(a.UsedTime) &"

'Set a=nothing

'rs.close

'Set rs=nothing

% >

更多信息請查看IT技術(shù)專欄

更多信息請查看網(wǎng)絡(luò)編程

上一篇：ASP根據(jù)父ID遞歸得到所有子類ID的函數(shù)代碼

下一篇：如何取得所有的Session變量

易賢網(wǎng)手機網(wǎng)站地址：asp操作Excel類

由于各方面情況的不斷調(diào)整與變化，易賢網(wǎng)提供的所有考試信息和咨詢回復(fù)僅供參考，敬請考生以權(quán)威部門公布的正式信息和咨詢?yōu)闇?zhǔn)！

相關(guān)閱讀網(wǎng)絡(luò)編程

Shell中如何刪除文本比較長的行的實現(xiàn)方法10月30日

vue.js語法及常用指令10月30日

python 讀寫中文json的實例詳解10月30日

Objective-C Json 實例詳解10月30日

bootstrap table sum總數(shù)量統(tǒng)計實現(xiàn)方法10月30日

python生成二維碼的實例詳解10月30日

Python批量更改文件名的實現(xiàn)方法10月30日

解決出現(xiàn)Incorrect integer value的問題10月30日

jQuery實現(xiàn)切換隱藏與顯示同時切換圖標(biāo)功能10月30日

docker python api 安裝配置的詳解10月30日

javascript按鈕禁用和啟用的效果實例代碼10月30日

vue.js todolist實現(xiàn)代碼10月30日

vue.js 父向子組件傳參的實例代碼10月30日

apache 開啟重定向 rewrite的實現(xiàn)方法10月30日

Vue.js劃分組件的方法10月30日

python logging日志模塊的詳解10月30日

vue中的scope使用詳解10月30日

docker cgroup 資源監(jiān)控的詳解10月30日

使用Android Studio 開發(fā)自己的SDK教程10月23日

linux系統(tǒng)下MongoDB單節(jié)點安裝教程10月23日

易賢網(wǎng)移動網(wǎng)站

2025國考·省考課程試聽報名

報班類型
姓名
手機號
驗證碼

午夜国产狂喷潮在线观看|国产AⅤ精品一区二区久久|中文字幕AV中文字幕|国产看片高清在线