Solved

How to set a shape object by referencing the ID number of an object in Office 2013 vba?

Posted on 2015-02-04
14
174 Views
Last Modified: 2016-02-10
I am revising old, complicated code.

Looping through the objects in a word.range I have identified an object I need to dupicate.  I have the ID number of that object.

In order to duplicate a shape in 2013 I must declare the object as a shape.  The following line doesn't work.

Set oshp = shp    

How to set the oshp (shape) to point to the current shp (object)?  Can I use the shp.ID to set the oshp?


Public Function SpecialTable(ByRef myrange As Word.range) As Variant 'tables

Dim shp as Object
Dim oshp As Shape
Dim newshpRange As shaperange
Dim newshp As Shape

    For Each shp In myrange.shaperange      
        If shp.Title = "chtGeoPieQ" Or shp.Title = "chtSegPiesQ" Then          
            Exit For
        End If
    Next shp

   If Not shp Is Nothing Then
       shpnum = shp.ID
       shptop = shp.top
       shpleft = 0
       Set oshp = shp
   End If

Thanks in Advance :o)
0
Comment
Question by:kkhan7
  • 8
  • 6
14 Comments
 
LVL 76

Accepted Solution

by:
GrahamSkan earned 500 total points
ID: 40589899
Without trying to analyse/reproduce the problem, can I suggest that you use Early Binding and tighter object definitions? This might give you an earlier clue about where the problem lies.
Public Function SpecialTable(ByRef myrange As Word.range) As Word.Table

Dim shp as Word.Shape
Dim oshp As  Word.Shape
Dim newshpRange As Word.Shaperange
Dim newshp As Shape

    For Each shp In myrange.shaperange      
        If shp.Title = "chtGeoPieQ" Or shp.Title = "chtSegPiesQ" Then          
            Exit For
        End If
    Next shp

   If Not shp Is Nothing Then
       shpnum = shp.ID
       shptop = shp.top
       shpleft = 0
       Set oshp = shp
   End If

Open in new window

0
 

Author Comment

by:kkhan7
ID: 40599304
Ok.  I will give it a shot.
0
 

Author Comment

by:kkhan7
ID: 40599338
Ok. Big Thanks!  The first hurdle with this code was solved using early binding as you suggested.
0
 

Author Comment

by:kkhan7
ID: 40599389
Dim shp as object
Dim oshp As Word.Shape      
Dim newshpRange As Word.shaperange
Dim newshp As Word.Shape

This next line works now.  As per your suggestion.
Set oshp = myrange.Document.Shapes.item(shp.Title)  


Now, I need to duplicate oshp to a newshp
   
With oshp
                        .Left = 0
                        .Width = piewidth
                        .Title = gprs("SpecName") & MainSpecGpid & "_Q" & QNum
                        .Chart.ChartTitle.Text = gprs("SpecName") & Chr(11) & gprs("nval")

'The next two lines causes an err
                         Set newshp = oshp.Duplicate              'err
                         Set newshpRange = oshp.Duplicate   'err
                         Set newshp = newshpRange(1)
                    End With


I need to figure out howto duplicate the oshp and set as newshp.  Do you have a suggestion for this?
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 40599649
What are the errors (number and text)?
0
 

Author Comment

by:kkhan7
ID: 40600998
Certain code makes Word crash.
Other code sends the focus back to calling function's On Error Resume Next line.   If I comment out this On Error Resume Next line then it takes much longer to get through the code.


Public Function SpecialTable(ByRef myrange As Word.range) As Variant 'tables

Dim shp As Object
Dim oshp As Word.Shape    
Dim newshpRange As shaperange
Dim newshp As Word.Shape

For Each shp In myrange.shaperange
        If shp.Title = "chtGeoPieQ" Or shp.Title = "chtSegPiesQ" Then
             Debug.Print shp.ID
             Debug.Print shp.Title
             Exit For
        End If
        k = k + 1
    Next shp

If Not shp Is Nothing Then
    shpnum = shp.ID
    shptop = shp.top
    shpleft = 0
    Set oshp = myrange.Document.Shapes.item(shp.Title)
End If

Why do these next lines cause an errors?
Set oshp = myrange.Document.Shapes.item(shp.ID)                             'causes an err
Set oshp = myrange.Document.Shapes(shp.ID)                                       'causes an err
Set newshp = myrange.Document.Shapes.item(shp.Title).Duplicate    'causes an err


How can I get the index# of an object or shape so I can use it to set a reference to it in another object?

So I can use:
Set oshp = myrange.Document.Shapes(i)

and

Set newshp = myrange.Document.Shapes(i).Duplicate

Thanks in advance for all your help!
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 40601112
Are you saying that there are no errors reported by the code, but the Word application aborts?

We don't know what is in your document or in the rest of the code, so if there are any errors, please tell us what they are.

Note that it is bad practice to use 'On Error Resume Next' to get past such errors because you won't know what is happening.
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 

Author Comment

by:kkhan7
ID: 40601134
Word 2013 stops working msg appears and crashes.

This test code:
Public Function SpecialTable(ByRef mydoc As Word.Document)
Dim oshp as Word.Shape
Dim newshp as Word.Shape
Dim currshp As String
currshp = oshp.name                                                                    'works
Debug.Print mydoc.Shapes.item(currshp).name                     'works
Set newshp = mydoc.Shapes(currshp).Duplicate                     'err crash
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 40601212
We can't see where you set the oshp object to anything. Without it you would get an error on the first line that tries to use it -
currshp = oshp.Name 

Open in new window


The error message would be:

Run-time error '91'
Object variable or With block variable not set

This code works OK on my system
Public Function SpecialTable() As Boolean 'ByRef mydoc As Word.Document)
    Dim oshp As Word.Shape
    Dim newshp As Word.Shape
    Dim currshp As String
    Dim mydoc As Word.Document
    
    Set mydoc = ActiveDocument
    Set oshp = mydoc.Shapes(1)
    currshp = oshp.Name                              'works
    Debug.Print mydoc.Shapes.Item(currshp).Name      'works
    Set newshp = mydoc.Shapes(currshp).Duplicate     'err crash
    SpecialTable = True
End Function

Open in new window

0
 

Author Comment

by:kkhan7
ID: 40601386
Sorry.  Here is a more complete code.

oshp is set by referencing the orig object by name.
Set oshp = myrange.Document.Shapes.item(shp.Title)    'works  

Does setting an object as shape change it to a shape?  As the above line does.


 Public Function SpecialTable(ByRef wrd As Word.Application, ByRef mydoc As Word.Document, ByRef myrange As Word.range) as variant 'Table

Dim shp as object
Dim oshp as Word.Shape
Dim newshp as Word.Shape
Dim currshp As String

If MiniPies Then
    'find orig shape
    Dim k As Integer
    k = 1
    For Each shp In myrange.shaperange
        If shp.Title = "chtGPQ" Or shp.Title = "chtSPQ" Then
        	Debug.Print shp.ID
        	Debug.Print shp.Title         'title and name are the same
        	Debug.Print shp.name
            Exit For
        End If
        k = k + 1
    Next shp

If Not shp Is Nothing Then
    shpnum = shp.ID
    shptop = shp.top
    shpleft = 0
    Set oshp = myrange.Document.Shapes.item(shp.Title)    'works
    
End If
End If

 With oshp
	.Left = 0
	 .Width = 10
	.Title = "YYYY"
	.Chart.ChartTitle.Text = "zzzzz"

	Debug.Print "oshp.name = " & oshp.name
	currshp = oshp.name                                'works

        'Debug.Print mydoc.Shapes.item(currshp).name       'works
        Set newshp = mydoc.Shapes(currshp).Duplicate       'err
                        
 End With

Open in new window


Thanks so much for sticking with this problem!
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 40602079
I can't actually test that because I am on Word 2007 and the Shape.Title property was new in Word 2010.

If the application aborts and you do not get VBA error message, then there might be something wrong with the Word installation. See if the steps here in this Microsoft article help:
https://support.microsoft.com/kb/921541
0
 

Author Comment

by:kkhan7
ID: 40606246
Thanks!! Based on your suggestion.  I am installing ms off 2013 prof pro on my home machine to test the shape duplicate command in a different environment.

If the shape duplicate command works on my home machine I will have to get desktop support in my org to look into their MS Office Prof Plus 2013 environment.
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 40606493
That sounds like a good idea.
One of my few skills is in getting the wrong end of the stick.
Other experts seem easily to understand the nub of the problem. So, to cater for those like me who are less intuitive, can I recommend a more precise description of the exact problem and its circumstance?
0
 

Author Closing Comment

by:kkhan7
ID: 40617259
Gave good advice.  Issue still unresovled.
0

Featured Post

Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

I recently resolved a client's Office 2013 installation problem and wanted to offer an observation that may help you with troubleshooting similar issues. The client ordered three Dell Optiplex system units with the Windows 7 downgrade option inst…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
XMind Plus helps organize all details/aspects of any project from large to small in an orderly and concise manner. If you are working on a complex project, use this micro tutorial to show you how to make a basic flow chart. The software is free when…
In a previous video Micro Tutorial here at Experts Exchange (http://www.experts-exchange.com/videos/1358/How-to-get-a-free-trial-of-Office-365-with-the-Office-2016-desktop-applications.html), I explained how to get a free, one-month trial of Office …

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now