咔片PPT · AI自动生成演示文稿,模板丰富、排版精美 讯飞智文 · 一键生成PPT和Word,高效应对学习与办公

使用XLSApp对象管理XLS文件的工作表

打开VB6工程,添加窗体和按钮


[表数]按钮

函数

GetSheetTotal -- 得到工作表数量

代码

Private Sub cmdGetSheetTotal_Click()

Dim DoXLS As XLSApp

Dim Error As String


Set DoXLS = New XLSApp


'打开XLS文件

If DoXLS.Open("Test1.xls", Error) = False Then

MsgBox Error

Set DoXLS = Nothing

Exit Sub

End If


'得到表数

MsgBox "工作表数:" & DoXLS.GetSheetTotal


'关闭XLS文件

DoXLS.Close

Set DoXLS = Nothing

End Sub

运行效果


[表名]按钮

函数

GetSheetName -- 得到指定序号的工作表的表名

代码

Private Sub Command1_Click()

Dim DoXLS As XLSApp

Dim SheetName As String

Dim Error As String


Set DoXLS = New XLSApp


'打开XLS文件

If DoXLS.Open("Test1.xls", Error) = False Then

MsgBox Error

Set DoXLS = Nothing

Exit Sub

End If


'得到表名

If DoXLS.GetSheetName(1, SheetName, Error) = False Then

MsgBox Error

Set DoXLS = Nothing

Exit Sub

End If

MsgBox "第一个工作表名:" & SheetName


'关闭XLS文件

DoXLS.Close

Set DoXLS = Nothing

End Sub

运行效果


[添加表]按钮

函数

AddSheet -- 添加一个工作表到最后位置

代码

Private Sub Command2_Click()

Dim DoXLS As XLSApp

Dim SheetName As String

Dim Error As String


Set DoXLS = New XLSApp


'打开XLS文件

If DoXLS.Open("Test1.xls", Error) = False Then

MsgBox Error

Set DoXLS = Nothing

Exit Sub

End If


'添加表

If DoXLS.AddSheet("NewSheet", Error) = False Then

MsgBox Error

Set DoXLS = Nothing

Exit Sub

End If


DoXLS.SaveAs "Test1.xls"


'关闭XLS文件

DoXLS.Close

Set DoXLS = Nothing


MsgBox "操作成功!"

End Sub

运行效果


[删除表]按钮

函数

DelSheet -- 删除一个工作表

代码

Private Sub Command3_Click()

Dim DoXLS As XLSApp

Dim SheetName As String

Dim Error As String


Set DoXLS = New XLSApp


'打开XLS文件

If DoXLS.Open("Test1.xls", Error) = False Then

MsgBox Error

Set DoXLS = Nothing

Exit Sub

End If


'删除表

If DoXLS.DelSheet("NewSheet", Error) = False Then

MsgBox Error

Set DoXLS = Nothing

Exit Sub

End If


DoXLS.SaveAs "Test1.xls"


'关闭XLS文件

DoXLS.Close

Set DoXLS = Nothing


MsgBox "操作成功!"

End Sub

运行效果


[修改表]按钮

函数

RenameSheet -- 修改一个工作表的表名

代码

Private Sub Command4_Click()

Dim DoXLS As XLSApp

Dim SheetName As String

Dim Error As String


Set DoXLS = New XLSApp


'打开XLS文件

If DoXLS.Open("Test1.xls", Error) = False Then

MsgBox Error

Set DoXLS = Nothing

Exit Sub

End If


'修改表

If DoXLS.RenameSheet("Sheet1", "First", Error) = False Then

MsgBox Error

Set DoXLS = Nothing

Exit Sub

End If


DoXLS.SaveAs "Test1.xls"


'关闭XLS文件

DoXLS.Close

Set DoXLS = Nothing


MsgBox "操作成功!"

End Sub

运行效果