好文档 - 专业文书写作范文服务资料分享网站

ExcelVBA编程实例(速成150例) - 图文 

天下 分享 时间: 加入收藏 我要投稿 点赞

示例03-28:备份工作簿

[示例03-28-01] 用与活动工作簿相同的名字但后缀名为.bak备份工作簿 Sub SaveWorkbookBackup()

Dim awb As Workbook, BackupFileName As String, i As Integer, OK As Boolean

If TypeName(ActiveWorkbook) = \ Set awb = ActiveWorkbook If awb.Path = \

Application.Dialogs(xlDialogSaveAs).Show Else

BackupFileName = awb.FullName i = 0

While InStr(i + 1, BackupFileName, \ i = InStr(i + 1, BackupFileName, \ Wend

If i > 0 Then BackupFileName = Left(BackupFileName, i - 1) BackupFileName = BackupFileName & \ OK = False

On Error GoTo NotAbleToSave With awb

Application.StatusBar = \正在保存工作簿...\ .Save

Application.StatusBar = \正在备份工作簿...\ .SaveCopyAs BackupFileName OK = True End With End If

NotAbleToSave:

Set awb = Nothing

Application.StatusBar = False If Not OK Then

MsgBox \备份工作簿未保存!\ End If End Sub 示例说明:在当前工作簿中运行本示例代码后,将以与工作簿相同的名称但后缀名为.bak备份工作簿,且该备份与当前工作簿在同一文件夹中。其中,使用了工作簿的FullName属性和SaveCopyAs方法。

[示例03-28-02] 保存当前工作簿的副本到其它位置备份工作簿 Sub SaveWorkbookBackupToFloppyD()

Dim awb As Workbook, BackupFileName As String, i As Integer, OK As Boolean

If TypeName(ActiveWorkbook) = \ Set awb = ActiveWorkbook If awb.Path = \

41

Application.Dialogs(xlDialogSaveAs).Show Else

BackupFileName = awb.Name OK = False

On Error GoTo NotAbleToSave

If Dir(\ Kill \ End If With awb

Application.StatusBar = \正在保存工作簿...\ .Save

Application.StatusBar = \正在备份工作簿...\ .SaveCopyAs \ OK = True End With End If

NotAbleToSave:

Set awb = Nothing

Application.StatusBar = False If Not OK Then

MsgBox \备份工作簿未保存!\ End If End Sub 示例说明:本程序将把当前工作簿进行复制并以与当前工作簿相同的名称保存在D盘中。其中,使用了Kill方法来删除已存在的工作簿。

示例03-29:从已关闭的工作簿中取值 [示例03-29-01]

Sub testGetValuesFromClosedWorkbook()

GetValuesFromAClosedWorkbook \End Sub

‘- - - - - - - - - - - - - - - - - - - - - - - Sub GetValuesFromAClosedWorkbook(fPath As String, _

fName As String, sName, cellRange As String) With ActiveSheet.Range(cellRange)

.FormulaArray = \

& sName & \ .Value = .Value End With End Sub

示例说明:本示例包含一个子过程GetValuesFromAClosedWorkbook,用来从已关闭的工作簿中获取数据,主过程testGetValuesFromClosedWorkbook用来传递参数。本示例表示从C盘根目录下的Book1.xls工作簿的工作表Sheet1中的A1:G20单元格区域内获取数据,并将其复制到当前工作表相应单元格区域中。

42

[示例03-29-02]

Sub ReadDataFromAllWorkbooksInFolder() Dim FolderName As String, wbName As String, r As Long, cValue As Variant Dim wbList() As String, wbCount As Integer, i As Integer FolderName = \文件夹名\ '创建文件夹中工作簿列表 wbCount = 0

wbName = Dir(FolderName & \ While wbName <> \

wbCount = wbCount + 1

ReDim Preserve wbList(1 To wbCount) wbList(wbCount) = wbName wbName = Dir Wend

If wbCount = 0 Then Exit Sub '从每个工作簿中获取数据 r = 0

Workbooks.Add

For i = 1 To wbCount r = r + 1

cValue = GetInfoFromClosedFile(FolderName, wbList(i), \\

Cells(r, 1).Formula = wbList(i) Cells(r, 2).Formula = cValue Next i End Sub

‘- - - - - - - - - - - - - - - - - - - - - - -

Private Function GetInfoFromClosedFile(ByVal wbPath As String, _

wbName As String, wsName As String, cellRef As String) As Variant Dim arg As String

GetInfoFromClosedFile = \

If Right(wbPath, 1) <> \ If Dir(wbPath & \ arg = \ wsName & \& Range(cellRef).Address(True, True, xlR1C1) On Error Resume Next

GetInfoFromClosedFile = ExecuteExcel4Macro(arg) End Function

示例说明:本示例将读取一个文件夹内所有工作簿中工作表Sheet1上单元格A1中的值到一个新工作簿中。代码中,“C:\\文件夹名”代表工作簿所在的文件夹名。

[示例03-29-03]

Sub GetDataFromClosedWorkbook() Dim wb As Workbook

43

Application.ScreenUpdating = False '以只读方式打开工作簿

Set wb = Workbooks.Open(\文件夹名\\文件.xls\ With ThisWorkbook.Worksheets(\工作表名\ '从工作簿中读取数据

.Range(\= wb.Worksheets(\源工作表名\

.Range(\= wb.Worksheets(\源工作表名\

.Range(\= wb.Worksheets(\源工作表名\

.Range(\= wb.Worksheets(\源工作表名\ End With

wb.Close False '关闭打开的源数据工作簿且不保存任何变化 Set wb = Nothing '释放内存

Application.ScreenUpdating = True End Sub

示例说明:在运行程序时,打开所要获取数据的工作簿,当取得数据后再关闭该工作簿。将屏幕更新属性值设置为False,将看不出源数据工作簿是否被打开过。本程序代码中,“C:\\文件夹名\\文件.xls”、\源工作表名\代表工作簿所在的文件夹和工作簿文件名。

第四章 工作表(Worksheet)基本操作应用示例

分类:ExcelVBA>>ExcelVBA编程入门范例

在编写代码时,经常要引用工作表的名字、知道工作表在工作簿中的位置、增加工作表、删除工作表、复制工作表、移动工作表、重命名工作表,等等。下面介

绍与此有关及相关的一些属性和方法示例。

[示例04-01]增加工作表(Add方法) Sub AddWorksheet()

MsgBox \在当前工作簿中添加一个工作表\ Worksheets.Add

MsgBox \在当前工作簿中的工作表sheet2之前添加一个工作表\ Worksheets.Add before:=Worksheets(\

MsgBox \在当前工作簿中的工作表sheet2之后添加一个工作表\ Worksheets.Add after:=Worksheets(\ MsgBox \在当前工作簿中添加3个工作表\ Worksheets.Add Count:=3 End Sub

示例说明:Add方法带有4个可选的参数,其中参数Before和参数After指定

44

所增加的工作表的位置,但两个参数只能选一;参数Count用来指定增加的工作表数目。

[示例04-02]复制工作表(Copy方法) Sub CopyWorksheet()

MsgBox \在当前工作簿中复制工作表sheet1并将所复制的工作表放在工作表sheet2之前\

Worksheets(\

MsgBox \在当前工作簿中复制工作表sheet2并将所复制的工作表放在工作表sheet3之后\

Worksheets(\End Sub

示例说明:Copy方法带有2个可选的参数,即参数Before和参数After,在使用时两个参数只参选一。

[示例04-03]移动工作表(Move方法) Sub MoveWorksheet()

MsgBox \在当前工作簿中将工作表sheet3移至工作表sheet2之前\ Worksheets(\ MsgBox \在当前工作簿中将工作表sheet1移至最后\

Worksheets(\End Sub

示例说明:Move方法与Copy方法的参数相同,作用也一样。

[示例04-04]隐藏和显示工作表(Visible属性) [示例04-04-01] Sub testHide()

MsgBox \第一次隐藏工作表sheet1\

Worksheets(\ MsgBox \显示工作表sheet1\

Worksheets(\ MsgBox \第二次隐藏工作表sheet1\

Worksheets(\ MsgBox \显示工作表sheet1\

Worksheets(\ MsgBox \第三次隐藏工作表sheet1\

Worksheets(\ MsgBox \显示工作表sheet1\

Worksheets(\ MsgBox \第四隐藏工作表sheet1\

Worksheets(\ MsgBox \显示工作表sheet1\

Worksheets(\ MsgBox \第五隐藏工作表sheet1\

45

ExcelVBA编程实例(速成150例) - 图文 

示例03-28:备份工作簿[示例03-28-01]用与活动工作簿相同的名字但后缀名为.bak备份工作簿SubSaveWorkbookBackup()DimawbAsWorkbook,BackupFileNameAsString,iAsInteger,OKAsBooleanIfTypeName(Active
推荐度:
点击下载文档文档为doc格式
701wu9w3bb3gyk61843d
领取福利

微信扫码领取福利

微信扫码分享