GetObject 函数的使用

计算机语言、软件、硬件
回复
peng
Site Admin
帖子: 199
注册时间: 周五 11月 01, 2019 9:06 am

GetObject 函数的使用

帖子 peng »

GetObject 函数ActiveX 对象的引用

返回文件中的 ActiveX 对象的引用。

语法

GetObject([pathname] [, class])

GetObject 函数的语法包含下面几个命名参数:

部分 描述
pathname 可选的;Variant (String)。包含待检索对象的文件的全路径和名称。如果省略 pathname,则 class 是必需的。
class 可选的;Variant (String)。代表该对象的类的字符串。


其中,class 参数的语法格式为 appname.objecttype,且语法的各个部分如下:

部分 描述
appname 必需的;Variant (String)。提供该对象的应用程序名称。
objecttype 必需的;Variant (String)。待创建对象的类型或类。


说明

使用 GetObject 函数可以访问文件中的 ActiveX 对象,而且可以将该对象赋给对象变量。可以使用 Set 语句将 GetObject 返回的对象赋给对象变量。例如:

Dim CADObject As Object
Set CADObject = GetObject("C:\CAD\SCHEMA.CAD")

当执行上述代码时,就会启动与指定的 pathname 相关联的应用程序,同时激活指定文件中的对象。

如果 pathname 是一个零长度的字符串 (""),则 GetObject 返回指定类型的新的对象实例。如果省略了 pathname 参数,则 GetObject 返回指定类型的当前活动的对象。如果当前没有指定类型的对象,就会出错。

有些应用程序允许只激活文件的一部分,其方法是在文件名后加上一个惊叹号 (!) 以及用于标识想要激活的文件部分的字符串。关于如何创建这种字符串的信息,请参阅有关应用程序创建对象的文档。

例如,在绘图应用程序中,一个存放在文件中的图可能有多层。可以使用下述代码来激活图中被称为 SCHEMA.CAD 的层:

Set LayerObject = GetObject("C:\CAD\SCHEMA.CAD!Layer3")

如果不指定对象的 class,则自动化会根据所提供的文件名,来确定被启动的应用程序以及被激活的对象。不过,有些文件可能不止支持一种对象类。例如,图片可能支持三种不同类型的对象:Application 对象,Drawing 对象,以及 Toolbar 对象,所有这些都是同一个文件中的一部分。为了说明要具体激活文件中的哪种对象,就应使用这个可选的 class 参数。例如:

Dim MyObject As Object
Set MyObject = GetObject("C:\DRAWINGS\SAMPLE.DRW", "FIGMENT.DRAWING")

在上述例子中,FIGMENT 是一个绘图应用程序的名称,而 DRAWING 则是它支持的一种对象类型。

对象被激活之后,就可以在代码中使用所定义的对象变量来引用它。在前面的例子中,可以使用对象变量 MyObject 来访问这个新对象的属性和方法。例如:

MyObject.Line 9, 90
MyObject.InsertText 9, 100, "Hello, world."
MyObject.SaveAs "C:\DRAWINGS\SAMPLE.DRW"

注意 当对象当前已有实例,或要创建已加载的文件的对象时,就使用 GetObject 函数。如果对象当前还没有实例,或不想启动已加载文件的对象,则应使用 CreateObject 函数。

如果对象已注册为单个实例的对象,则不管执行多少次 CreateObject,都只能创建该对象的一个实例。若使用单个实例对象,当使用零长度字符串 ("") 语法调用时,GetObject 总是返回同一个实例,而若省略 pathname 参数,就会出错。不能使用 GetObject 来获取 Visual Basic 创建的类的引用。

VBA里的GetObject 函数示例
该示例使用 GetObject 函数来获取对指定的 Microsoft Excel 的工作表 (MyXL) 的引用。它使用工作表的 Application 属性来显示或关闭 Microsoft Excel 等等。DetectExcel Sub 过程通过调用两个 API 函数,来查找 Microsoft Excel。如果 Microsoft Excel 正在运行,则将其放入运行对象表(Running Object Table)中。如果 Microsoft Excel 不在运行,则第一次调用 GetObject 将导致错误。在本例中,出现该错误则把 ExcelWasNotRunning 标志设为 True。第二次调用 GetObject 是指定要打开的一个文件。如果 Microsoft Excel 不在运行,则这个第二次的调用将启动该程序,并返回一个指定文件 (mytest.xls) 所对应的工作表的引用。该文件必须位于指定的位置;否则将产生 Visual Basic 错误及自动化错误。随后的示例代码将 Microsoft Excel 及包含指定工作表的窗口设为可见。最后,如果在此前没有 Microsoft Excel 的副本在运行,代码就使用 Application 对象的 Quit 方法来关闭 Microsoft Excel。如果该应用程序原来就在运行,则不要试图关闭它。引用本身在设为 Nothing 后被释放。
'声明必要的 API 例程:
Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName as String, _
ByVal lpWindowName As Long) As Long

Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hWnd as Long,ByVal wMsg as Long _
ByVal wParam as Long, _
ByVal lParam As Long) As Long

Sub GetExcel()
Dim MyXL As Object '用于存放Microsoft Excel 引用的变量。
Dim ExcelWasNotRunning As Boolean '用于最后释放的标记。

'测试 Microsoft Excel 的副本是否在运行。
On Error Resume Next '延迟错误捕获。
'不带第一个参数调用 Getobject 函数将返回对该应用程序的实例的引用。如果该应用程序不在运行,则会产生错误。
Set MyXL = Getobject(, "Excel.Application")
If Err.Number <> 0 Then ExcelWasNotRunning = True
Err.Clear '如果发生错误则要清除 Err 对象。
DetectExcel '检测 Microsoft Excel。如果 Microsoft Excel 在运行,则将其加入运行对象表。
Set MyXL = Getobject("c:\vb4\MYTEST.XLS") '将对象变量设为对要看的文件的引用。

'设置其 Application 属性,显示 Microsoft Excel。然后使用 MyXL 对象引用的 Windows 集合显示包含该文件的实际窗口。
MyXL.Application.Visible = True
MyXL.Parent.Windows(1).Visible = True
'在此处对文件进行操作。
' ...
'如果在启动时,Microsoft Excel 的这份副本不在运行中,则使用 Application 属性的 Quit 方法来关闭它。
'注意,当试图退出 Microsoft Excel 时,标题栏会闪烁,并显示一条消息询问是否保存所加载的文件。
If ExcelWasNotRunning = True Then
MyXL.Application.Quit
End IF
Set MyXL = Nothing '释放对该应用程序
'和电子数据表的引用。
End Sub

Sub DetectExcel() '该过程检测并登记正在运行的 Excel。
Const WM_USER = 1024
Dim hWnd As Long
'如果 Excel 在运行,则该 API 调用将返回其句柄。
hWnd = FindWindow("XLMAIN", 0)
If hWnd = 0 Then '0 表示没有 Excel 在运行。
Exit Sub
Else
SendMessage hWnd, WM_USER + 18, 0, 0 'Excel 在运行,因此可以使用 SendMessage API 函数将其放入运行对象表。
End If
End Sub

解决用GetObject打开的工作表修改后保存,再次打开工作表不显示
通过getobject打开的Excel文件只要被修改(写)并保存后,就只能在VBE中看到,但用户界面却看不到。就算你重启Excel,再去手动打开此文件,也是什么都看不到。不保存就没有这个问题!如果要解决这个问题,必须在wb.close 前加一句Application.Windows(wb.name).Visible = True。

Private Sub CommandButton1_Click()
On Error Resume Next
文件目录 = ThisWorkbook.Path & "\Excel\"
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldr = fso.GetFolder(文件目录)
For Each s In fldr.Files
With GetObject(文件目录 & s.Name)
.Sheets(1).Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False '随便做一点改动
.SaveAs ThisWorkbook.Path & "\Excel_修改后\" & s.Name '保存
.Windows(1).Visible = True '工作表可见
.Close (True) '保存改动
End With
Next
End Sub

回复