I tried this code to store an active shape to a temporary variable but I got a debug error, it said that shp is a "shape/shape" type and temp_variable is only a "shape" type but they are declared of the same type :
Dim temp_variable as Visio.shape
Dim shp As Visio.Shape
Dim pagShape As Visio.Shape
Set pagShape = Visio.ActivePage.PageSheet
For Each shp In Visio.ActivePage.Shapes
If condition = True Then 'some conditions about the shape
temp_variable = shp
End If
Next shp
'then I can work on temp_variable
End Function
If you want to identify a shape and store it in a temp_variable how would you do it ?
Thank you very much in advance
I just needed to use the key word SET :
Set temp_variable = shp
Related
I wrote a macro in Visio to retrieve the value for the shape property field index, but the row value keeps changing from shape to shape (sometimes 5 and sometimes 8). However, I can't find a way to replace the value 5 in CellsSRC with a solution that focuses on the row name rather than the row value. Any suggestions how I can find the value for the property "Index"?
This is my macro:
Sub Select_Shape()
Dim vsoPage As Visio.Page
Dim vsoShape As Visio.Shape
Dim vsoLayers As Visio.Layers
Set vsoPage = ActivePage
Set vsoLayers = vsoPage.Layers
ShapeID = ActiveWindow.Selection.PrimaryItem.ID 'find shape ID
Set vsoShape2 = Application.ActiveWindow.Page.Shapes.ItemFromID(ShapeID)
index_num = vsoShape2.CellsSRC(visSectionProp, 5, visCustPropsValue).FormulaU 'retrieve index value <-- Here is the issue
End Sub
This is the value I am looking for:
Many thanks for any suggestions!
I ended up solving the issue by calling the value of the cell, which is called "Prop._VisDM_Index", directly:
Sub Select_Shape()
Dim vsoPage As Visio.Page
Dim vsoShape As Visio.Shape
Dim vsoLayers As Visio.Layers
Dim cel As Visio.Cell
Set vsoPage = ActivePage
Set vsoLayers = vsoPage.Layers
ShapeID = ActiveWindow.Selection.PrimaryItem.ID
Set vsoShape2 = Application.ActiveWindow.Page.Shapes.ItemFromID(ShapeID)
Call Deselect_layers
shape_value = vsoShape2.Cells("Prop._VisDM_Index").FormulaU
vsoLayers.Item(shape_value).CellsC(visLayerVisible).FormulaU = "1"
End Sub
I'd like to change the proprieties of the lines in my schematics.
The code works, except if lines are in a group.
Dim shp As Visio.Shape
For Each shp In Visio.ActiveWindow.Selection
'// Add cell and formula/results here:
shp.Cells("linecolor") = 0
Next shp
Set shp = Nothing
End Sub
For each shape you need to check the number of shapes within the group, viz.
shp.shapes.count > 0
then iterate over those shapes setting your line color there as well.
For each shp2 in shp.shapes
Of course, each of these shapes may also be a group, so a recursive routine is called for here.
Here's my final code, in case someone else will be looking for the same problem:
For Each shp In Visio.ActiveWindow.Selection
shapeCount = shp.Shapes.Count
If shapeCount > 0 Then
For Each shp2 In shp.Shapes
'// Add cell and formula/results here:
shp2.Cells("linecolor") = 0
Next shp2
End If
Next shp
I'm a new stackoverflow user so I'm not sure if I'm doing this right, but I'm trying to post a question on a previously given solution by Steve Rindsberg. I don't have enough reputation to comment, and there doesn't appear to be a way to message another user directly, so I'm posting a new question here.
I can't seem to get the code below to work. I'm using PowerPoint O365 Version 1901 and I have two type of shapes I'm trying to convert, msoChart and msoLinkedOLEObject (some Excel worksheets). I originally changed ppPasteEnhancedMetafile to ppPastePNG because I want PNG's, but it fails with either.
Here is the code:
Sub ConvertAllShapesToPic()
Dim oSl As Slide
Dim oSh As Shape
For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
' modify the following depending on what you want to
' convert
Select Case oSh.Type
Case msoChart, msoEmbeddedOLEObject, msoLinkedOLEObject
ConvertShapeToPic oSh
Case msoPlaceholder
If oSh.PlaceholderFormat.ContainedType = msoEmbeddedOLEObject _
Or oSh.PlaceholderFormat.ContainedType = msoLinkedOLEObject _
Or oSh.PlaceholderFormat.ContainedType = msoChart _
Then
ConvertShapeToPic oSh
End If
Case Else
End Select
Next
Next
End Sub
Sub ConvertShapeToPic(ByRef oSh As Shape)
Dim oNewSh As Shape
Dim oSl As Slide
Set oSl = oSh.Parent
oSh.Copy
Set oNewSh = oSl.Shapes.PasteSpecial(ppPastePNG)(1)
With oNewSh
.Left = oSh.Left
.Top = oSh.Top
Do
.ZOrder (msoSendBackward)
Loop Until .ZOrderPosition < oSh.ZOrderPosition
End With
oSh.Delete
End Sub
I noticed if I run ConvertAllShapesToPic from an link/action in Slide Show mode, it doesn't complete and fails silently. If I add a Command Button (ActiveX control) and run it from there I get the following:
Run-time error '-2147188160 (80048240)':
Shapes (unknown member): Invalid request. The specified data type is unavailable.
It's failing on Set oNewSh = sld.Shapes.PasteSpecial(ppPastePNG)(1). After the error, if I go back to the slide and Ctrl-V I get the image, so I know it's working up to that point.
I've tried various solutions I found online for this such as adding DoEvents or ActiveWindow.Panes(1).Activate after the copy, but it doesn't seem to make a difference. Any suggestions?
Thanks
I found some other code to convert the charts and then I break links on the worksheets which automatically turns them in to images.
One thing I figured out was you must be out of slide show mode to break msoLinkedOLEObject links. I'm not 100% sure why... but this is the code that works for me:
Sub DoStuff()
Call LinkedGraphsToPictures
ActivePresentation.SlideShowWindow.View.Exit
Call BreakAllLinks
End Sub
Sub LinkedGraphsToPictures()
Dim shp As Shape
Dim sld As Slide
Dim pic As Shape
Dim shp_left As Double
Dim shp_top As Double
For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.Type = msoChart Then
'Retrieve current positioning
shp_left = shp.Left
shp_top = shp.Top
'Copy/Paste as Picture
shp.Copy
DoEvents
sld.Shapes.PasteSpecial DataType:=ppPastePNG
Set pic = sld.Shapes(sld.Shapes.Count)
'Delete Linked Shape
shp.Delete
'Reposition newly pasted picture
pic.Left = shp_left
pic.Top = shp_top
End If
Next shp
Next sld
End Sub
Sub BreakAllLinks()
Dim shp As Shape
Dim sld As Slide
For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.Type = msoLinkedOLEObject Then
shp.LinkFormat.BreakLink
End If
Next shp
Next sld
End Sub
In word I'm using the following to insert a text from an input box in a designated area in word:
Sub OpenWord()
Dim var1 As String
var1 = InputBox("vul!")
Documents.Open ("C:\Documents and Settings\aa471714\Desktop\TEMP BESTANDEN/Doc2.doc")
ActiveDocument.Bookmarks("Test").Select
Selection.Text = var1
End Sub
I know would like to create to same function for something in powerpoint. So what I did in word (classifying a bookmark area in word as "test" and then fill in a variable there) in want to do in powerpoint as well. Define an object in some way so I can fill in a variable there.
Anybody a clue on how I have to do this in PPT?
Here's the basics of what you need.
Sub WriteToTextBox()
Dim tb As Shape
Dim sld As Slide
Dim pres As Presentation
Dim var1 As String
var1 = InputBox("Var1")
Set pres = ActivePresentation
Set sld = pres.Slides(23) 'Modify as needed
Set tb = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, 100, 50) 'Modify dimensions as needed
tb.name = "unique name" '< assign a unique name to the textbox so you can refer to it later
tb.TextFrame.TextRange.Text = var1
End Sub
Sub ReadFromTextBox()
Dim s$
Dim sld As Slide
Dim pres As Presentation
Set pres = ActivePresentation
Set sld = pres.Slides(23) 'Modify as needed
s = sld.Shapes("unique name").TextFrame.TextRange.Text 'Read the value from the textbox
MsgBox s
End Sub
I am able to export Charts as JPG files from Powerpoint, but haven't been able to do this with a table, which as far as I can tell is still a "Shape" which should be able to export.
This is a cleansed version of the code I use to export the Chart as JPG.
Const imgFilePath as String = "ChartImage.JPG"
Sub ExportChartJPG()
Dim cht as Variant 'this will hold the Chart/Shape object
Set cht = ActivePresentation.Slides(1).Shapes("Chart1").Chart
On Error Resume Next
Kill imgPath
On Error GoTo 0
cht.Export imgPath, "JPG"
End Sub
I figured this would be simple to modify, like:
Sub ExportChartJPG()
Dim cht as Variant 'this will hold the Chart/Shape object
Set cht = ActivePresentation.Slides(1).Shapes("Table1").Table
On Error Resume Next
Kill imgPath
On Error GoTo 0
cht.Export imgPath, "JPG"
End Sub
But this is throwing an error 13 Mismatch.
I have also tried dimensioning cht as a Shape instead of Variant, and setting cht = ActivePresentation.Slides(1).Shapes("Table1"), also unsuccessfully.
Although KazJaw's solution works, it was a bit cumbersome (copying takes additional time to process, I was getting errors I think as a result of not "waiting" long enough for the copy to complete, clipboard issues? etc.)
http://www.tech-archive.net/pdf/Archive/Office/microsoft.public.office.developer.vba/2006-10/msg00046.pdf
I open the object browser, right-click, and show hidden methods, which now allows me to use the Export method on a Shape.
Sub ExportShapeJPG()
Dim cht as Variant 'this will hold the Chart/Shape object
Set cht = ActivePresentation.Slides(1).Shapes("Table1") '<-- removed .Table and only pass the Shape itself
'Likewise, for charts, omit the .Chart:
' Set cht = ActivePresentation.Slides(1).Shapes("Chart1")
On Error Resume Next
Kill imgPath
On Error GoTo 0
cht.Export imgPath, ppShapeFormatJPG '<-- The export syntax is slightly different using ppShapeFormatJPG instead of "JPG"
End Sub
I have one quite weird idea. Look at the code where first part save a chart and second save table.
Sub ExportinChartAndTable()
Dim imgFilePath As String
imgFilePath = ActivePresentation.Path & "\chart"
Dim shp As Shape
Set shp = ActivePresentation.Slides(1).Shapes(1)
Dim shpChart As Chart
Set shpChart = shp.Chart
'exporting chart
On Error Resume Next
Kill imgFilePath
On Error GoTo 0
shpChart.Export imgFilePath & "chart.jpg", "JPG"
Stop
Dim chartPart As ChartData
Set chartPart = shpChart.ChartData
imgFilePath = ActivePresentation.Path & "\dataTable.jpg"
chartPart.Workbook.worksheets("arkusz1").Range("a1:c20").Copy
shpChart.Paste
shpChart.Shapes(1).Width = shp.Width
shpChart.Shapes(1).Height = shp.Height
On Error Resume Next
Kill imgFilePath
On Error GoTo 0
shpChart.Export imgFilePath, "JPG"
End Sub
You have to come up with idea how to check the range of the table. I hoped that CurrentRegion would work but it's not. You could use the possibility to count the amount of rows and columns in the table (it is possible). Or maybe you have fixed range so it would be easy. One more thing, you have to adjust dimension when table is resized.
EDIT due to David comment. I keep the above solution in place as could be useful for others (please refer to comments below)
Sub SolutionSecond()
Dim whereTo As String
whereTo = ActivePresentation.Path & "\table.jpg"
Dim shp As Shape
Set shp = ActivePresentation.Slides(1).Shapes(1)
Dim chrt As Shape
Set chrt = ActivePresentation.Slides(1).Shapes.AddChart
shp.Copy
'required due to excel opening proces
chrt.Select
chrt.Chart.Paste
'set dimensions here
chrt.Chart.Export whereTo, "JPG"
chrt.Delete
End Sub
This one base on the same logic. Copy table into chart which (the only kind of Shape) could be exported.