6.1 在奔跑之前先学会走路:打开和关闭工作薄

代码清单6.1:一个完整的工作薄批处理框架

'代码清单6.1:一个完整的工作薄批处理框架
Sub ProcessFileBatch()
Dim nIndex As Integer
Dim vFiles As Variant
Dim wb As Workbook
Dim bAlreadyOpen As Boolean On Error GoTo ErrHandler 'Get a batch of Excel files
vFiles = GetExcelFiles("Select Workbooks for Processing" ) 'Make sure the dialog wasn't cancelled - in which case
'vFiles would equal False and therefore wouldn't be an array.
If Not IsArray(vFiles) Then
Debug.Print "No files Selected."
Exit Sub
End If Application.ScreenUpdating = False 'OK - loop through the filenames
For nIndex = To UBound (vFiles) If isWorkbookOpen(CStr(vFiles(nIndex))) Then
Set wb = Workbooks(GetShortName(CStr (vFiles(nIndex))))
Debug.Print "workbook already open: " & wb.Name
bAlreadyOpen = True Else
Set wb = Workbooks.Open(CStr(vFiles(nIndex)), False )
Debug.Print "Opened workbook: " & wb.Name
bAlreadyOpen = False End If Application.StatusBar = "processing workbook: " & wb.Name 'code to process the file goes here
Debug.Print "if we wanted to do something to the workbook, we would do it here" 'close workbook unless it was already open
If Not bAlreadyOpen Then
Debug.Print "closing workbook: " & wb.Name
wb.Close True
End If
Next nIndex Set wb = Nothing
ErrHandler:
Application.StatusBar = False
Application.ScreenUpdating = True End Sub

6.2 工作薄打开了吗

代码清单6.2:查看一个工作薄是否是打开的

'代码清单6.2: 查看一个工作薄是否是打开的
' This function checks to see if a given workbook
' is open or not. this function can be used
' using a short name such as MyWorkbook.xls
' or a full name such as C: \Testing\MyWorkbook.xls
Function isWorkbookOpen(sWorkbook As String) As Boolean
Dim sName As String
Dim sPath As String
Dim sFullName As String On Error Resume Next
isWorkbookOpen = True 'see if we were given a short name or a long name
If InStr(, sWorkbook, "\", vbTextCompare) > Then
'we have a long name need to break it down
sFullName = sWorkbook 'BreakdownName参见代码清单5.8
BreakdownName sFullName, sName, sPath
If StrComp(Workbooks(sName).FullName, sWorkbook, vbTextCompare) <> Then
isWorkbookOpen = False
End If
Else
'we have a short name
If StrComp(Workbooks(sWorkbook).Name, sWorkbook, vbTextCompare) <> Then
isWorkbookOpen = False
End If
End If End Function

另一个IsWorkbookOpen:

Function IsWorkbookOpen(sWorkbookName AsString) As Boolean
Dim wb As Workbook IsWorkbookOpen = False
For Each wb In Workbooks
If StrComp(sWorkbookName, wb.Name, vbTextCompare) = Then
IsWorkbookOpen = True
Exit Function
End If
Next
Set wb =Nothing
End Function

三个VBA字符串函数:

InStr([start, ]string1, string2[, compare]): 指出string2在string1中第一次出现的位置。

InStrRev(string1, string2[, compare]): 指出string2在string1中最后一次出现的位置。

StrComp(string1, string2[, compare]): 比较两个字符串,返回-1、0、1中的值。

说明:

VBA中,字符串的索引是基于0的。

compare可以取值vbTextCompare或者vbBinaryCompare,前者表示不区分大小写,后者表示区分大小写。compare的默认值为vbUseCompareOption,就是取模块选项的设置。

6.2.1 指定特定的集合对象

下面的例子示范了可以指向集合中的一个项目的4种方法。这个例子使用Worksheets集合对象。

Sub ReferringToItems()
'refer to a worksheet by index number
Debug.Print ThisWorkbook.Worksheets( ).Name
'once again, but with feeling
Debug.Print ThisWorkbook.Worksheets.Item( ).Name 'refer to a worksheet by name
Debug.Print ThisWorkbook.Worksheets("Sheet1" ).Name
'and gain using item ...
Debug.Print ThisWorkbook.Worksheets.Item("Sheet1" ).Name End Sub

6.3以编程方式解开链接(第1部分)

代码清单6.3:以程序设计方式得到链接资源信息

'代码清单6.3:以程序设计方式得到链接资源信息
Sub PrintSimpleLinkInfo(wb As Workbook)
Dim avLinks As Variant
Dim nIndex As Integer 'get list of excel based link sources
avLinks = wb.LinkSources(xlExcelLinks)
If Not IsEmpty(avLinks) Then
'loop through every link source
For nIndex = To UBound (avLinks)
Debug.Print "link found to '" & avLinks(nIndex) & "'"
Next nIndex
Else
Debug.Print "the workbook '" & wb.Name & "' don't have any links."
End If End Sub

代码清单6.4:用新的文件位置更新链接

'代码清单6.4: 用新的文件位置更新链接
Sub fixLinks(wb As Workbook, sOldLink As String, sNewLink As String )
On Error Resume Next
wb.ChangeLink sOldLink, sNewLink, xlLinkTypeExcelLinks End Sub

代码清单6.5:用新的文件位置更新链接(一个替代过程)

'代码清单6.5: 用新的文件位置更新链接—一个替代过程
Sub FixLinksII(wb As Workbook, sOldLink As String, sNewLink As String )
Dim avLinks As Variant
Dim nIndex As Integer 'get a list of link sources
avLinks = wb.LinkSources(xlExcelLinks) 'if there are link sources, see if there are any named sOldLink
If Not IsEmpty(avLinks) Then
For nIndex = To UBound (avLinks)
If StrComp(avLinks(nIndex), sOldLink, vbTextCompare) = Then
'we have a match
wb.ChangeLink sOldLink, sNewLink, xlLinkTypeExcelLinks
'once we find a match we won't find another, so exit the loop
Exit For
End If
Next
End If End Sub

代码清单6.6:链接状态查看器

'代码清单6.6: 链接状态查看器
Function GetLinkStatus(wb As Workbook, sLink As String) As String
Dim avLinks As Variant
Dim nIndex As Integer
Dim sResult As String
Dim nStatus As Integer 'get a list of link sources
avLinks = wb.LinkSources(xlExcelLinks) 'make sure there are links in the workbook
If IsEmpty(avLinks) Then
GetLinkStatus = "No links in workbook."
Exit Function
End If 'default result in case the links is not found
sResult = "link not found" For nIndex = To UBound (avLinks)
If StrComp(avLinks(nIndex), sLink, vbTextCompare) = Then
nStatus = wb.LinkInfo(sLink, xlLinkInfoStatus) Select Case nStatus
Case xlLinkStatusCopiedValues
sResult = "Copied values" Case xlLinkStatusIndeterminate
sResult = "Indeterminnate" Case xlLinkStatusInvalidName
sResult = "Invalid name" Case xlLinkStatusMissingFile
sResult = "Missing file" Case xlLinkStatusMissingSheet
sResult = "Missing sheet" Case xlLinkStatusNotStarted
sResult = "Not started" Case xlLinkStatusOK
sResult = "OK" Case xlLinkStatusOld
sResult = "Old" Case xlLinkStatusSourceNotCalculated
sResult = "Source Not Calculated" Case xlLinkStatusSourceNotOpen
sResult = "Source Not Open" Case xlLinkStatusSourceOpen
sResult = "Source Open" Case Else
sResult = "Unknown status code"
End Select
End If
Next End Function

代码清单6.7:查看一个工作薄中所有的链接状态

'代码清单6.7: 查看一个工作薄中所有的链接状态
Sub CheckAllLinks(wb As Workbook)
Dim avLinks As Variant
Dim nLinkIndex As Integer
Dim sMsg As String avLinks = wb.LinkSources(xlExcelLinks) If IsEmpty(avLinks) Then
Debug.Print wb.Name & " does not have any links."
Else
For nLinkIndex = To UBound (avLinks)
Debug.Print "workbook: " & wb.Name
Debug.Print "link source: " & avLinks(nLinkIndex)
Debug.Print "status: " & GetLinkStatus(wb, CStr (avLinks(nLinkIndex)))
Next
End If End Sub

6.4 简单普通的工作薄属性

代码清单6.8:一个标准工作薄属性的简单例子

'代码清单6.8: 一个标准工作薄属性的简单例子
Sub TestPrintGeneralWBInfo()
PrintGeneralWorkbookInfo ThisWorkbook
End Sub Sub PrintGeneralWorkbookInfo(wb As Workbook)
Debug.Print "Name: " & wb.Name
Debug.Print "Full Name: " & wb.FullName
Debug.Print "Code Name: " & wb.CodeName
Debug.Print "File Format: " & GetFileFormat(wb)
Debug.Print "path: " & wb.Path If wb.ReadOnly Then
Debug.Print " the workbook has been opened as read-only."
Else
Debug.Print " the workbook is read-write."
End If If wb.Saved Then
Debug.Print "the workbook does not need to be saved."
Else
Debug.Print " the workbook should be saved."
End If
End Sub Function GetFileFormat(wb As Workbook) As String
Dim lFormat As Long
Dim sFormat As String
lFormat = wb.FileFormat
Select Case lFormat
Case xlAddIn: sFormat = "Add-In" Case xlCSV: sFormat = "CSV"
Case xlCSVMac: sFormat = "CSV Mac"
Case xlCSVMSDOS: sFormat = "CSV MSDOS"
Case xlCSVWindows: sFormat = "CSV Windows" Case xlCurrentPlatformText: sFormat = "Current Platform Text" Case xlDBF2: sFormat = "DBF 2"
Case xlDBF3: sFormat = "DBF 3"
Case xlDBF4: sFormat = "DBF 4" Case xlDIF: sFormat = "xlDIF"
Case xlExcel2: sFormat = "xlExcel2"
Case xlExcel2FarEast: sFormat = "xlExcel2FarEast"
Case xlExcel3: sFormat = "xlExcel3"
Case xlExcel4: sFormat = "xlExcel4"
Case xlExcel4Workbook: sFormat = "xlExcel4Workbook"
Case xlExcel5: sFormat = "xlExcel5"
Case xlExcel7: sFormat = "xlExcel7"
Case xlExcel9795: sFormat = "xlExcel9795" Case xlHtml: sFormat = "xlHtml"
Case xlIntlAddIn: sFormat = "xlIntlAddIn"
Case xlSYLK: sFormat = "xlSYLK"
Case xlTemplate: sFormat = "xlTemplate"
Case xlTextMac: sFormat = "xlTextMac"
Case xlTextMSDOS: sFormat = "xlTextMSDOS"
Case xlTextPrinter: sFormat = "xlTextPrinter"
Case xlTextWindows: sFormat = "xlTextWindows"
Case xlUnicodeText: sFormat = "xlUnicodeText"
Case xlWebArchive: sFormat = "xlWebArchive"
Case xlWJ2WD1: sFormat = "xlWJ2WD1"
Case xlWJ3: sFormat = "xlWJ3"
Case xlWJ3FJ3: sFormat = "xlWJ3FJ3" Case xlWK1: sFormat = "xlWK1"
Case xlWK1ALL: sFormat = "xlWK1ALL"
Case xlWK1FMT: sFormat = "xlWK1FMT"
Case xlWK3: sFormat = "xlWK3"
Case xlWK3FM3: sFormat = "xlWK3FM3"
Case xlWK4: sFormat = "xlWK4"
Case xlWKS: sFormat = "xlWKS"
Case xlWorkbookNormal: sFormat = "xlWorkbookNormal"
Case xlWorks2FarEast: sFormat = "xlWorks2FarEast"
Case xlWQ1: sFormat = "xlWQ1"
Case xlXMLSpreadsheet: sFormat = "xlXMLSpreadsheet" Case Else
sFormat = "Unknown format code"
End Select
GetFileFormat = sFormat
End Function

6.5 响应用户动作事件

代码清单6.9:测试Workbook对象事件

Private Sub Workbook_Activate()
If UseEvents Then
MsgBox "Welcome back! ", vbOKOnly, "Activate Event"
End If
End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean )
Dim lResponse As Long If UseEvents Then
lResponse = MsgBox("Thanks for visiting!" & "Are you sure you don't want to stick around?", vbYesNo, "see ya.." )
End If
End Sub Private Sub Workbook_Deactivate()
If UseEvents Then
MsgBox "see you soon...", vbOKOnly, "Deactivate Event"
End If
End Sub Private Sub Workbook_Open()
Dim lResponse As Long
lResponse = MsgBox("Welcome to the Chapter Six Example Workbook! Would you like to use events?", vbYesNo, "Welcome" ) If lResponse = vbYes Then
TurnOnEvents True
ElseIf lResponse = vbNo Then
TurnOnEvents False
End If
End Sub Private Sub TurnOnEvents(bUseEvents As Boolean)
On Error Resume Next
If bUseEvents Then
ThisWorkbook.Worksheets().Range("TestEvents").Value = "Yes"
Else
ThisWorkbook.Worksheets().Range("TestEvents").Value = "No"
End If
End Sub Private Function UseEvents() As Boolean
On Error Resume Next UseEvents = False
If UCase(ThisWorkbook.Worksheets().Range("TestEvents").Value) = "YES" Then
UseEvents = True
End If
End Function Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If UseEvents Then
MsgBox "Activated " & Sh.Name, vbOKOnly, "SheetActivate Event"
End If
End Sub Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean )
If UseEvents Then
MsgBox "Ouch! Stop that.", vbOKOnly, "SheetBeforeDoubleClick Event"
End If
End Sub Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean )
If UseEvents Then
MsgBox "Right click " & Sh.Name & "; Target " & Target.Address & "; Cancel " & Cancel, vbOKOnly, "RightClick Event"
End If
End Sub Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If UseEvents Then
MsgBox "You change the range" & Target.Address & " on " & Sh.Name, vbOKOnly, "Workbook_SheetChange Event"
End If
End Sub Private Sub Workbook_SheetDeactivate(ByVal Sh As Object )
If UseEvents Then
MsgBox "Leaving " & Sh.Name, vbOKOnly, "Workbook_SheetDeactivate Event"
End If
End Sub Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If UseEvents Then
If Target.Row Mod = Then
MsgBox "I'm keeping my eyes on you! you selected the range " & Target.Address & " on " & Sh.Name, _
vbOKOnly, "Workbook_SheetSelectionChange Event"
Else
MsgBox "you selected the range " & Target.Address & " on " & Sh.Name, _
vbOKOnly, "Workbook_SheetSelectionChange Event"
End If
End If
End Sub

6 Workbook 对象的更多相关文章

  1. Workbook对象的方法总结(一)

    import openpyxlwb=openpyxl.Workbook()print('1.添加前所有工作簿的名称是:',wb.get_sheet_names())wb.create_sheet('F ...

  2. 【VBA编程】13.Workbook对象的事件

    Workbook事件用于响应对Workbook对象所进行的操作. [BeforeClose事件] BforeClose事件用于响应窗口关闭的操作 在工程资源器中,双击“ThisWorkbook”对象, ...

  3. Workbook对象的方法总结(二)

    (1).Worksheet 对象有 row_dimensions 和 column_dimensions 属性,控制行高和列宽. 例如: >>> sheet.row_dimensio ...

  4. 【VBA编程】12.Workbook对象常用属性

    [ActiveSheet属性] ActiveSheet属性用于返回一个对象,表示活动工作簿中或指定的窗口或工作簿中的活动工作表 [Colors] Colors属性是一个Variant类型的可读写属性, ...

  5. POI完美解析Excel数据到对象集合中(可用于将EXCEL数据导入到数据库)

    实现思路: 1.获取WorkBook对象,在这里使用WorkbookFactory.create(is); // 这种方式解析Excel.2003/2007/2010都没问题: 2.对行数据进行解析 ...

  6. 电子表格控件Spreadsheet 对象方法事件详细介绍

    1.ActiveCell:返回代表活动单元格的Range只读对象.2.ActiveSheet:返回代表活动工作表的WorkSheet只读对象.3.ActiveWindow:返回表示当前窗口的Windo ...

  7. Excel 文件转 JSON格式对象

    将导入的如图所示格式的城乡区划代码的excel文件整理成json格式的对象储存在js文件中: var PROJECTDISTRICTDATA=[    {        "name" ...

  8. NPOI:创建Workbook和Sheet

    NPOI官方网站:http://npoi.codeplex.com/ 创建Workbook说白了就是创建一个Excel文件,当然在NPOI中更准确的表示是在内存中创建一个Workbook对象流.在看了 ...

  9. java excel Workbook API

    此文摘自:http://blog.sina.com.cn/zenyunhai 1. int getNumberOfSheets() 获得工作薄(Workbook)中工作表(Sheet)的个数,示例: ...

随机推荐

  1. MySQL-----一对一

    一对一: 用户表和博客表 用户表(userinfo): 用户id 用户名 1 George 2 root 3 Bruce 4 Catherine 博客表: 博客id 博客名 用户id(FK + 唯一) ...

  2. Caused by: java.io.IOException: 您的主机中的软件中止了一个已建立的连接。

    异常详情 2017-07-16 10:55:26,218 ERROR [500.jsp] - java.io.IOException: 你的主机中的软件中止了一个已建立的连接. org.apache. ...

  3. LeetCode(55)Jump Game

    题目 Given an array of non-negative integers, you are initially positioned at the first index of the a ...

  4. 洛谷 3106 [USACO14OPEN]GPS的决斗Dueling GPS's 3720 [AHOI2017初中组]guide

    [题解] 这两道题是完全一样的. 思路其实很简单,对于两种边权分别建反向图跑dijkstra. 如果某条边在某一种边权的图中不是最短路上的边,就把它的cnt加上1.(这样每条边的cnt是0或1或2,代 ...

  5. Codeforces Round #321 (Div. 2)-B. Kefa and Company,区间最大值!

    ->链接在此<- B. Kefa and Company time limit per test 2 seconds memory limit per test 256 megabytes ...

  6. ZOJ 3329 期望DP

    题目大意: 给定3个已经规定好k1,k2,k3面的3个色子,如果扔到a,b,c则重新开始从1 计数,否则不断叠加所有面的数字之和,直到超过n,输出丢的次数的数学期望 我们在此令dp[]数组记录从当前数 ...

  7. 2-sat相关知识

    转载:http://blog.csdn.net/luyuncheng/article/details/15172827 此题好纠结啊...其实2-sat关键是建边 此题网上好多题解都是直接说了建边而且 ...

  8. BBS+Blog项目代码

    项目目录结构: cnblog/ |-- blog/(APP) |-- migrations(其中文件略) |-- templatetags/ |-- my_tags.py |-- utils/ |-- ...

  9. Layui图标

    layui 图标 layui 的所有图标全部采用字体形式,取材于阿里巴巴矢量图标库(iconfont).因此你可以把一个 icon 看作是一个普通的文字,这意味着你直接用 css 控制文字属性,如 c ...

  10. [bzoj2058][Usaco2010 Nov]Cow Photographs_树状数组_动态规划

    Cow Photographs bzoj-2058 Usaco-2010 Nov 题目大意:给定一个n的排列.每次操作可以交换相邻两个数.问将序列变成一个:$i,i+1,i+2,...,n,1,2,. ...