Accessing open workbook in a sub generates Error 1004 "Method of 'Sheets' of Object '_Global' not failed" sometimes - excel

I am getting inconsistent results when I try to refer to an active workbook. About half the time I get the "Method of 'Sheets' of Object '_Global' not failed" error and other times the code works fine. I don't see a pattern.
The VBA code is part of a Word document that allows the user to open a template Excel file and select/copy text from the Word doc into rows on the Excel file.
In a previous sub I successfully open an Excel template file (I call it a RTM template). In the code below I want to activate the "RTM" worksheet, select the first cell where the template could already have data in it from a previous execution and if there is, then count how many rows of data exist. In this way the new data will be posted in the first row which does not have any data. I am using named ranges in my Workbook to refer to the starting cell ("First_Cell_For_Data").
When I run my code sometimes it runs without error and other times it stops on the "Sheets("RTM").Activate" and gives me the "Method...." error. The same result occurs when I change the variable definition of wb_open to Object. I have also tried using "wb_open.Sheets("RTM").Activate" with the same results.
As suggested in the comments below I added "If wb_open is nothing ...." to debug the issue. I also added the sub List_Open_Workbooks which enumerates the open workbooks (of which there is only 1) and activates the one that matches the name of the one with the correct filename. This is successful. But upon returning to Check_Excel_RTM_Template I still get the Method error on the "Sheets("RTM").Activate" line.
Second Update: after more time diagnosing the problem (which still occurs intermittently) I have added some code that may help getting to the root of the problem. In the "List_Open_Workbooks" sub I test for xlApp.Workbooks.Count = 0. So all references to an open Excel workbook will fail. At this point my template workbook is open in Windows. Am I drawing the correct conclusion?
Third Update: I tried Set wb_open = GetObject(str_filename) where str_filename contains the name of the Excel template file I just opened.
I get the following error message.
Also, I noticed that if I start with a fresh launch of Word and Excel it seems to run just fine.
Sub Check_Excel_RTM_Template(b_Excel_File_Has_Data As Boolean, i_rows_of_data As Integer)
Dim i_starting_row_for_data As Integer
Dim wb_open As Object
Set wb_open = ActiveWorkbook
i_rows_of_data = 0
If wb_open Is Nothing Then
MsgBox "RTM Workbook not open in Check_Excel_RTM_Template"
Call List_Open_Workbooks(b_Excel_File_Has_Data, i_rows_of_data)
Else
' On Error GoTo Err1:
' Sheets("RTM").Activate
' range("First_Cell_For_Data").Select
Workbooks(wb_open.Name).Worksheets("RTM").range("First_Cell_For_Data").Select
If Trim(ActiveCell.Value) <> "" Then
b_Excel_File_Has_Data = True
Do Until Trim(ActiveCell.Value) = ""
ActiveCell.Offset(1, 0).Select
i_rows_of_data = i_rows_of_data + 1
Loop
Else
b_Excel_File_Has_Data = False
End If
End If
Exit Sub
Err1:
MsgBox getName(str_Excel_Filename) & " is not a RTM template file."
b_abort = True
End Sub
Sub to enumerate all open workbooks
Sub List_Open_Workbooks(b_Excel_File_Has_Data As Boolean, i_rows_of_data As Integer)
Dim xlApp As Excel.Application
Set xlApp = GetObject(, "Excel.Application")
Dim str_filename As String
Dim xlWB As Excel.Workbook
If xlApp.Workbooks.Count = 0 Then
MsgBox "Error: Windows thinks there are no workbooks open in List_Open_Workbooks"
b_abort = True
Exit Sub
End If
For Each xlWB In xlApp.Workbooks
Debug.Print xlWB.Name
str_filename = getName(str_Excel_Filename)
If Trim(xlWB.Name) = Trim(str_filename) Then
xlWB.Activate
If xlWB Is Nothing Then
MsgBox "Workbook still not active in List_Open_Workbooks"
b_abort = True
Exit Sub
Else
' Sheets("RTM").Activate
Workbooks(xlWB.Name).Worksheets("RTM").range("First_Cell_For_Data").Select
range("First_Cell_For_Data").Select
If Trim(ActiveCell.Value) <> "" Then
b_Excel_File_Has_Data = True
Do Until Trim(ActiveCell.Value) = ""
ActiveCell.Offset(1, 0).Select
i_rows_of_data = i_rows_of_data + 1
Loop
Else
b_Excel_File_Has_Data = False
End If
End If
End If
Next xlWB
Set xlApp = Nothing
Set xlWB = Nothing
End Sub
Function to extract filename from path/filename
Function getName(pf)
getName = Split(Mid(pf, InStrRev(pf, "\") + 1), ".")(0) & ".xlsx"
End Function

I am hoping I found the source of my problem and solved it.
I believe that referring to an open workbook in sub using Dim wb_open As Object & Set wb_open = ActiveWorkbook in the Check_Excel_RTM_Template sub is causing my inconsistent problems....perhaps this is an anomoly (bug) in the VBA implementation in Word.
In the revised code I posted below I am passing the o_Excel object from the calling routine and using oExcel.Activesheet.xxx to reference ranges and values.
Now I next problem is that I am having errors on the form control button code which also uses the Dim wb_open As Object & Set wb_open = ActiveWorkbook approach to referring to the open workbook. But I'll post that as a new question.
Thanks to all who commented and provided suggestions.
Sub Check_Excel_RTM_Template(oExcel As Object)
Dim i_starting_row_for_data As Integer
Dim str_filename As String
i_rows_of_data = 0
On Error GoTo Err1:
oExcel.ActiveSheet.range("First_Cell_For_Data").Select
If Trim(oExcel.ActiveCell.Value) <> "" Then
b_Excel_File_Has_Data = True
Do Until Trim(oExcel.ActiveCell.Value) = ""
oExcel.ActiveCell.Offset(1, 0).Select
i_rows_of_data = i_rows_of_data + 1
Loop
Else
b_Excel_File_Has_Data = False
End If
Exit Sub
Err1:
Documents(str_doc_index).Activate
MsgBox getName(str_Excel_Filename) & " is not a RTM template file."
b_abort = True
End Sub

Related

Open & Check out Excel workbook from SharePoint

I'm trying to write data into an Excel workbook that is hosted in our SharePoint document library.
I instantiate Excel from Microsoft Project.
I tried the following:
Check if file can be checked out
If it can be checked out, then open it
Here's the code snippet:
If ExcelApp.Workbooks.CanCheckOut (FileURL) = True Then
Set NewBook = ExcelApp.Workbooks.Open(FileName:=FileURL, ReadOnly:=False)
ExcelApp.Workbooks.CheckOut (FileURL)
Else
MsgBox "File is checked out in another session."
End If
The CanCheckOut function always returns FALSE. I'm not able to tell when a file can be checked out by the Excel instance.
Is it not working because I'm calling the VBA code from MS Project?
My app should be able to check if a file is not checked out, then check it out, update it, and save + check it back in.
I've found through trial and error that Workbooks.CanCheckOut (Filename:= FullName) where FullName is the URL for the SharePoint file only works for files that are not open in the current instance of Excel.
The method will always return False if you have the file open in the current instance of Excel which is obviously the case here.
Workbooks.CheckOut (ActiveWorkbook.FullName) opens the file, checks it out and then inexplicably, closes the file. So opening and checking out a SharePoint file becomes a 3 step process.
Sub CheckOutAndOpen()
Dim TestFile As String
TestFile = "http://spserver/document/Test.xlsb"
If Workbooks.CanCheckOut(TestFile) = True Then
Workbooks.CheckOut(TestFile)
Workbooks.Open (TestFile)
Else
MsgBox TestFile & " can't be checked out at this time.", vbInformation
End If
End Sub
This is all a bit counter intuitive because when working manually with SharePoint files you have to open them to see if they can be checked out and then perform the check-out operation.
Neither MSDN or Excel VBA help mention that the Workbooks.CanCheckOut (Filename:= FullName) method always returns False if you have the file open in the current instance of Excel.
The other methods never worked for me. This will CheckOut the file and either open it hidden and terminate (Visible = False), or you can just have it open (Visible = True) and remove the Quit, BUT while the doc is Checked out, I can't seem to target or check in that mXLApp doc further. The solution is to not leave the mXLApp doc open, but then once closed to open that same doc as normal, and then it will Check in with the Check in code line.
Sub TestCheckOut()
Dim FileName as String
FileName = "http://spserver/document/Test.xlsx"
SP_CheckOut FileName
End Sub
Sub SP_CheckOut(docCheckOut As String)
Set mXlApp = CreateObject("Excel.Application")
' Determine if workbook can be checked out.
' CanCheckOut does not actually mean the doc is not currently checked out, but that the doc can be checked in/out.
If mXlApp.Workbooks.CanCheckOut(docCheckOut) = True Then
mXlApp.Workbooks.Open fileName:=docCheckOut
mXlApp.Workbooks.CheckOut docCheckOut
' False is hidden
mXlApp.Visible = False
mXlApp.Quit
Set mXlApp = Nothing
Workbooks.Open fileName:=docCheckOut
Else
MsgBox "Unable to check out this document at this time."
End If
End Sub
As for Checkin, can't get any methods to work except:
Workbooks(CheckName).checkin SaveChanges:=True, Comments:=""
Sub CheckIn(CheckName As String, CheckPath As String)
' Must be open to save and then checkin
Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks(CheckName)
If Err = 0 Then
WorkbookIsOpen = True
Else
WorkbookIsOpen = False
Set wb = Workbooks.Open(CheckPath)
End If
wb.CheckIn SaveChanges:=True, Comments:=""
End Sub
I did try using a Query on the SharePoint browser link to determine who has the doc checked out (if anyone). This worked sometimes. If it did work, half the time it would take too long to be useful, and the other half of the time it would throw a timeout error. Not to mention the query would disrupt other processes, like saving or certain other macros. So I put together a WebScrape which quickly returns who might have the doc checked out.
Sub TestWho()
Dim SPFilePath As String
SPFilePath = "http://teams.MyCompany.com/sites/PATH/PATH/Fulfillment/Forms/AllItems.aspx"
Debug.Print CheckedByWho(SPFilePath , "YOURdocName.xlsx")
End Sub
Function CheckedByWho(ShareFilePath As String, ShareFileName As String)
Dim ie As Object
Dim CheckedWho As String
Dim ImgTag As String
Dim CheckStart, CheckEnd As Integer
Dim SplitArray() As String
Set ie = GetObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}")
With ie
.Visible = False
.Navigate ShareFilePath
Do Until .readyState = 4: DoEvents: Loop
Do While .Busy: DoEvents: Loop
End With
CheckedWho = "Not Check Out"
For Each objLink In ie.document.getElementsByTagName("img")
ImgTag = objLink.outerHTML
CheckedOutPos = InStr(objLink.outerHTML, ShareFileName & "
Checked Out To:")
If CheckedOutPos > 0 Then
CheckStart = InStr(objLink.outerHTML, "Checked Out To: ")
CheckedWho = Mid(objLink.outerHTML, CheckedOutPos + 41)
SplitArray = Split(CheckedWho, """")
CheckedWho = SplitArray(0)
End If
Next objLink
CheckedByWho = CheckedWho
ie.Quit
End Function

Pass parameter from VbScript to vba function

I want to call a vba function from vbscript which has a parameter, I Know how to call a parameterized sub but having issue with function
Here is what I have tried, I tried the code here Calling vba function(with parameters) from vbscript and show the result , but this also didn't work, it gave an error as expected end of statement
Set xlObj = CreateObject("Excel.Application")
Set objWorkbook = xlObj.Workbooks.Open("E:\Headers.xlsm")
xlObj.Application.Visible = False
xlObj.Workbooks.Add
Dim result
result = xlObj.Application.Run("Headers.xlsm!Headers",filename)
xlFile.Close True
xlObj.Quit
this my vba function
Function Headers(filename As String) As String
Application.ScreenUpdating = False
Dim myWb As Workbook
Dim i As Integer
Dim flag As Boolean
Set myWb = Workbooks.Open(filename:=filename)
Dim arr
arr = Array("col1","col2")
For i = 1 To 2
If Cells(1, i).Value = arr(i - 1) Then
Headers = "True"
Else
Headers = "False , Not Found Header " & arr(i - 1)
Exit Function
End If
Next
myWb.Close
End Function
In your VBScript xlObj is set to be an application Set xlObj = CreateObject("Excel.Application"). That means xlObj.Application should be xlObj only.
In your VBScript Filename is not declared nor set to a value therefore it is empty. You need to define value to it.
Set xlObj = CreateObject("Excel.Application")
Set objWorkbook = xlObj.Workbooks.Open("E:\Headers.xlsm")
xlObj.Visible = False
xlObj.Workbooks.Add
Dim Filename 'declare filename and set a value to it
Filename = "E:\YourPath\Yourfile.xlsx"
Dim Result
Result = xlObj.Run("Headers.xlsm!Headers", Filename)
xlFile.Close True
xlObj.Quit
In your function you use Exit Function. This will stop the code immediately at this point, which means your workbook myWb will not be closed! It stays open because myWb.Close is never reached. Change Exit Function to Exit For to just exit the loop and continue to close the workbook.
Cells(1, i).Value is neither specified which workbook it is in nor which worksheet. This is not very reliable never call Cells or Range without specifying workbook and worksheet (or Excel will guess which one you mean, and Excel can fail if you are not precise).
Therfore I recommend to use something like myWb.Worksheets(1).Cells(1, i).Value if you always mean the first worsheet in that workbook. Alternatively if it has a defined name using its name would be more reliable: myWb.Worksheets("SheetName").Cells(1, i).Value
If you turn off ScreenUpdating don't forget to turn it on in the end.
Error handling in case filename does not exist would be nice to not break the function.
You can slightly improve speed by assuming Headers = "True" as default and just turn it False in case you find any non matching header. This way the variable is only set once to True instead of multiple times for every correct header.
Public Function Headers(ByVal Filename As String) As String
Application.ScreenUpdating = False
Dim flag As Boolean 'flag is never used! you can remove it
On Error Resume Next 'error handling here would be nice to not break if filename does not exist.
Dim myWb As Workbook
Set myWb = Workbooks.Open(Filename:=Filename)
On Error Goro 0 'always reactivate error reporting after Resume Next!!!
If Not myWb Is Nothing Then
Dim Arr() As Variant
Arr = Array("col1", "col2")
Headers = "True" 'assume True as default and just change it to False if a non matching header was found (faster because variable is only set true once instead for every column).
Dim i As Long 'better use Long since there is no benefit in using Integer
For i = 1 To UBound(arr) + 1 'use `ubound to find the upper index of the array, so if you add col3 you don't need to change the loop boundings
If Not myWb.Worksheets(1).Cells(1, i).Value = Arr(i - 1) Then 'define workbook and worksheet for cells
Headers = "False , Not Found Header " & Arr(i - 1)
Exit For '<-- just exit loop but still close the workbook
End If
Next i
Else
Headers = "File '" & Filename & "' not found!"
End If
Application.ScreenUpdating = True
myWb.Close
End Function

Running Excel Macro through Access VBA Runtime Error -2147417851

I created code that will copy the RecordSet to Excel and I want a macro in the Excel file to run. The code works perfectly until it hits the code to run the macro. I must not be calling the application correctly but can't figure it out!
Private Sub Command233_Click()
Dim objXLS As Object
Dim wks As Object
Dim rsc As Recordset
Dim idx As Long
Set rsc = Me.RecordsetClone
If Me.RecordsetClone.RecordCount = 0 Then
MsgBox ("No Records To Export")
Else
rsc.MoveLast
rsc.MoveFirst
Set objXLS = CreateObject("Excel.Application")
objXLS.Workbooks.Open FileName:="C:\Comps Macro.xlsm", ReadOnly:=True
Set wks = objXLS.Worksheets(1)
For idx = 0 To rsc.Fields.Count - 1
wks.Cells(1, idx + 1).Value = rsc.Fields(idx).Name
Next
wks.Range(wks.Cells(1, 1), wks.Cells(1, rsc.Fields.Count)).Font.Bold = True
wks.Range("A2").CopyFromRecordset rsc, rsc.RecordCount, rsc.Fields.Count
objXLS.Visible = True
objXLS.Run ("Format")
End If
Set objXLS = Nothing
End Sub
The runtime error I am receiving is:
Run-Time Error '-2147417851 (80010105)':
Method 'Run' of object '_Application' failed
You have to reference the Sub or Function correctly.
Your Sub named Format is defined at Workbook- or Sheet- level?
If defined in a Sheet module (for example Sheet1):
objXLS.Run ("Sheet1.Format")
If at Workbook level:
objXLS.Run ("ThisWorkbook.Format")
Hope this helps

runtime error 91 excel vba, Object not set

what is wrong with the following code?, Every time I run it I get a "Run-Time Error 91, Object variable or with black variable not set"
Private Sub Document_Open()
Dim workBook As workBook
Application.ScreenUpdating = True
Set workBook = Workbooks.Open("Z:\Credit_Check_DB.xls", True, True)
txtCompany1.Value = workBook.Worksheets("Sheet2").Range("A1").Formula
txtCompany2.Value = workBook.Worksheets("Sheet2").Range("A1").Formula
txtCityState1.Value = workBook.Worksheets("Sheet2").Range("C1").Formula
txtCityState2.Value = workBook.Worksheets("Sheet2").Range("C1").Formula
txtDate1.Value = workBook.Worksheets("Sheet2").Range("F1").Value
txtAddress1.Value = workBook.Worksheets("Sheet2").Range("B1").Formula
txtZip1.Value = workBook.Worksheets("Sheet2").Range("D1").Formula
txtPO.Value = "Purchase Order#: " & workBook.Worksheets("Sheet2").Range("I1").Formula
txtRec.Value = workBook.Worksheets("Sheet2").Range("K1").Formula
workBook.Close False
Set workBook = Nothing
Application.ScreenUpdating = True
Close_Excel
End Sub
Private Sub Close_Excel() 'closes excel application.
Dim Excel As Excel.Application
Dim ExcelOpened As Boolean
ExcelOpened = False
On Error Resume Next
Set Excel = GetObject(, "Excel.Application")
If Excel Is Nothing Then
Set Excel = New Excel.Application
ExcelOpened = True
End If
On Error GoTo 0
With Excel
If ExcelOpened Then
.Visible = True
.Workbooks.Add
End If
.ActiveWorkbook.Close False ***<-***!!!!!Debugger points to here!!!!!******
.Quit
End With
End Sub
any idea what is wrong with my code? I am basically pulling information from Excel into word.
Maybe Excel does not point to any Excel application (something went wrong, but you skipped the error), so ActiveWorkbook points to nothing. You should put On Error GoTo 0 immediately after GetObject.

Macro in PowerPoint which links to data stored in an Excel Spreadsheet

I have an Excel Spreadsheet (let's say objectdata.xls) which is used to set the widths/lengths of different rectangles. The spreadsheet therefore has 3 columns:
Object Name
Object Width
Object Length
There are approx 100 rectangles defined in the Spreadsheet
What i am try to do is run a macro in a PowerPoint (PP) which will read the data from the Spreadsheet (ideally this info should be stored external to the PP file but if need be it could be a linked or embedded file within PP) and then update the size of the rectangle shapes that I have included in the PP file.
E.g. on slide one, the macro reads row 1 in the spreadhseet and sees that the object width is 5 and length is 10, and so updates the size of the rectangle shape in the PP.
Can anyone tell me if this can be done?
Thanks.
Use GetExcelData to do the work; it calls GetExcel
Function GetExcel() As Object
'---------------------------------------------------------------------------------------
' Procedure : GetExcel
' Author : Naresh Nichani / Steve Rindsberg
' Purpose :
' Check if an instance of Excel is running. If so obtain a reference to the running Excel application
' Otherwise Create a new instance of Excel and assign the XL application reference to oXLApp object
' SR : Modified 2010-02-23 to ALWAYS create a new instance rather than using an existing one, so when we
' : close the one we open, we don't wack the user's other instances of Excel if any
' Params : None
' Returns : An Excel Application object on success, Nothing on failure
'---------------------------------------------------------------------------------------
On Error GoTo GetExcel_ErrorHandler
On Error Resume Next
Err.Number = 0
Dim oXLAPP As Object
' Comment out the following bits to force a new instance of Excel
' and leave any existing instances alone
' Set oXLApp = GetObject(, "Excel.Application")
' If Err.Number <> 0 Then
' Err.Number = 0
Set oXLAPP = CreateObject("Excel.Application")
If Err.Number <> 0 Then
'MsgBox "Unable to start Excel.", vbInformation, "Start Excel"
Exit Function
End If
' End If
On Error GoTo GetExcel_ErrorHandler
If Not oXLAPP Is Nothing Then
Set GetExcel = oXLAPP
Else
[MASTTBAR].rnrErrLog "modExcel:GetExcel - unable to invoke Excel instance"
End If
Set oXLAPP = Nothing
Exit Function
NormalExit:
On Error GoTo 0
Exit Function
GetExcel_ErrorHandler:
Resume NormalExit
End Function
Function GetExcelData(sFilename As String, _
Optional lWorksheetIndex As Long = 1, _
Optional sWorksheetName As String = "") As Variant
'---------------------------------------------------------------------------------------
' Purpose : Gets the "active" data from the file/worksheet specified
Dim oXLAPP As Object
Dim oxlWB As Object
Dim oxlRange As Object
Dim x As Long
Dim y As Long
Dim sMsg As String
Dim lVisibleRowCount As Long
Dim lVisibleColCount As Long
Dim aData() As String
On Error GoTo GetExcelData_ErrorHandler
Set oXLAPP = GetExcel()
If oXLAPP Is Nothing Then
Exit Function
End If
' open the workbook read-only
Set oxlWB = oXLAPP.Workbooks.Open(sFilename, , True)
If oxlWB Is Nothing Then
Exit Function
End If
If Len(sWorksheetName) > 0 Then
Set oxlRange = GetUsedRange(oxlWB.Worksheets(sWorksheetName))
Else
Set oxlRange = GetUsedRange(oxlWB.Worksheets(lWorksheetIndex))
End If
If oxlRange Is Nothing Then
Exit Function
End If
' Get a count of visible rows/columns (ignore hidden rows/cols)
For x = 1 To oxlRange.Rows.Count
If Not oxlRange.Rows(x).Hidden Then
lVisibleRowCount = lVisibleRowCount + 1
End If
Next ' row
For y = 1 To oxlRange.Columns.Count
If Not oxlRange.Columns(y).Hidden Then
lVisibleColCount = lVisibleColCount + 1
End If
Next
ReDim aData(1 To lVisibleRowCount, 1 To lVisibleColCount)
lVisibleRowCount = 0
For x = 1 To oxlRange.Rows.Count
If Not oxlRange.Rows(x).Hidden Then
lVisibleRowCount = lVisibleRowCount + 1
lVisibleColCount = 0
For y = 1 To oxlRange.Columns.Count
If Not oxlRange.Columns(y).Hidden Then
lVisibleColCount = lVisibleColCount + 1
aData(lVisibleRowCount, lVisibleColCount) = oxlRange.Cells(x, y).Text
End If
Next
End If
Next
' return data in array
GetExcelData = aData
NormalExit:
On Error GoTo 0
' Close the workbook
If Not oxlWB Is Nothing Then
oXLAPP.DisplayAlerts = False
oxlWB.Close
oXLAPP.DisplayAlerts = True
End If
'To Close XL application
If Not oXLAPP Is Nothing Then
oXLAPP.Quit
End If
'Set the XL Application and XL Workbook objects to Nothing
Set oxlRange = Nothing
Set oxlWB = Nothing
Set oXLAPP = Nothing
Exit Function
GetExcelData_ErrorHandler:
Resume NormalExit
End Function
Blockquote
Blockquoteenter code here
Yes, this can certainly be done. It takes a bit more code than I have at the tip of my fingers and you'd need to adapt whatever I posted. But have a look here for examples you can start with. These point to the PowerPoint FAQ site that I maintain. No charge for anything.
Controlling Office Applications from PowerPoint (by Naresh Nichani and Brian Reilly)
http://www.pptfaq.com/FAQ00795.htm
Automate Excel from PowerPoint. Automate PowerPoint from Excel. And so on.
http://www.pptfaq.com/FAQ00368.htm
I'd probably do this by opening the excel file, reading the contents into an array, then using the data from the array to do the actual work in PPT.
If you need help with the PPT part, let us know. It'd mostly be a matter of writing a function like [aircode]:
Sub SetRectangleSize ( sRectangleName as string, sngWidth as Single, sngHeight as Single)
Dim oShp as Shape
Set oShp = GetShapeNamed(sRectangleName, lSlideIndex)
If Not oShp is Nothing Then
With oShp
.Width = sngWidth
.Height = sngHeight
End With
End If
End Sub
And
Function GetShapeNamed(sName as String, lSlideIndex as Long) as Shape
On Error Resume Next
Set GetShapeNamed = ActivePresentation.Slides(lSlideIndex).Shapes(sName)
If Err.Number <> 0 Then
' no shape by that name on the slide; return null
Set GetShapeNamed = Nothing
End If
End Function
Incidentally, I would consider using tags to identify the rectangles rather than shape names (which tend to be less reliable).

Resources