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
Related
I would like to create the macro which will format the selected "DATA LABELS" in chart in powerpoint. Below is my code. But the problem is Im not able to write code for selected "Data Labels". Please assist
Sub testSelection2()
Dim shp As Shape
Dim count As Integer
Dim left_count As Double
Dim Selected_Series As Integer
Dim PPoint As Integer
Set shp = ActiveWindow.Selection.ShapeRange(1)
count = shp.Chart.SeriesCollection(1).Points.count
For i = 1 To count
shp.Chart.SeriesCollection(2).Points(i).DataLabel.Format.TextFrame2.TextRange.Font.Size = 12
Next
End Sub
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
I would like to get some VBA code which would tell me the number of sheets in a Catia drawing. Each sheet would have a title block placed on it. A text field on each title block would communicates the number of sheets. So if you had three sheets in the drawing you would have 1 of 3 (in the title block sheet 1) 2 of 3 (in the title block shhet 2) and 3 of 3 (in the title block sheet 3). If the macro could update all title blocks on all sheets automatically.
Any help much appreciated.
The concept is to loop through all of the DrawingSheet objects in the Sheets collection of the DrawingDocument you should put all title block elements in the "Background View". Next we need to update or create existing title block text elements. These are DrawingText objects. We try to access the DrawingText by name(THIS MUST BE UNIQUE!). If it does not exist, we create it. If it does exist, we update the value.
Here's a start to making your title block:
Option Explicit
Sub UpdateSheetPage()
Dim DrawingDoc As DrawingDocument
Dim DSheet As DrawingSheet
Dim DView As DrawingView
Dim SheetCount As Integer
Dim currentSheet As Integer
'the drawing must be the active docuement window or this will fail. you can do more error checking if needed
On Error GoTo ExitSub
Set DrawingDoc = CATIA.ActiveDocument
SheetCount = DrawingDoc.Sheets.Count
currentSheet = 1 'initialize sheet number
'loop through all sheets and update or create a sheet number
For Each DSheet In DrawingDoc.Sheets
UpdatePageNumber DSheet, currentSheet, SheetCount
currentSheet = currentSheet + 1
Next
ExitSub:
End Sub
Sub UpdatePageNumber(currentDrawingSheet As DrawingSheet, currentSheetNumber As Integer, totalSheets As Integer)
Dim sheetNumber As String
Dim xPos, yPos As Long 'mm
'edit these if needed
xPos = 100 'edit this - only use for new creation
yPos = 100 'edit this
'display format
sheetNumber = "Page " & currentSheetNumber & "/" & totalSheets
Dim backgroundView As DrawingView
Dim dTexts As DrawingTexts
Dim currentText As DrawingText
Set backgroundView = currentDrawingSheet.Views.Item("Background View")
Set dTexts = backgroundView.Texts
On Error GoTo CreateNew
Set currentText = dTexts.GetItem("SheetNumber")
currentText.Text = sheetNumber
Exit Sub
CreateNew:
Set currentText = dTexts.Add(sheetNumber, xPos, yPos)
currentText.Name = "SheetNumber" 'so we can access it later for an update
End Sub
I am trying to create a VB macro in Visio that can read the data and properties of the shape. So say I have a Rectangle Shpae in Visio with Cells Name, Description, Type, Size.... and so on.
When I try to read the cells and their values I am only getting the first cell and its value.
Here is my code . I would appreciate some help here.
Sub Testing()
Dim excelObj As Object
Dim excelFile As String
Dim sheetName As String
' Dim excelBook As Excel.Workbook
' Set excelFile = "C:\Users\hbhasin\Documents\test.xls"
'Set sheetName = "New Sheet name"
Set excelObj = CreateObject("Excel.Application")
excelObj.Workbooks.Add
Dim pagObj As Visio.Page
Dim shpsObj As Visio.shapes
Dim shapes As Visio.shapes
Dim shpObj As Visio.Shape
Dim CellObj As Visio.Cell
Dim Storage() As String
Dim iShapeCount As Integer
Dim i As Integer
Dim j As Integer
Set pagObj = ActivePage
Set shpsObj = pagObj.shapes
iShapeCount = shpsObj.Count
Debug.Print iShapeCount
ReDim Storage(8, iShapeCount - 1)
For i = 1 To iShapeCount - 1
Set shpObj = shpsObj(i)
Storage(1, i - 1) = shpObj.Name
If shpObj.CellExists("Prop.Name", visExistsLocally) Then
Set CellObj = shpObj.CellsU("Prop.Name")
Storage(2, i - 1) = CellObj.ResultStr("")
End If
If shpObj.CellExists("Prop.Description", visExistsLocally) Then
Debug.Print "Test the IF statement"
Set CellObj = shpObj.CellsU("Prop.Description")
Storage(3, i - 1) = CellObj.ResultStr("")
End If
Next
For i = 0 To iShapeCount - 1
Debug.Print "Name- " & Storage(0, i)
Debug.Print "Description-" & Storage(1, i)
Next
End Sub
In fact, I have put a debug statement within the second if clause and that does not execute which tells me the compiler is not even seeing the second cell or any cell after.
If you're not getting the Description Shape Data it maybe that it's not local, but inherited from its master. Here's a slight modification of your code (with the Excel part removed as I don't think it's relevant here):
Sub Testing()
Dim shpsObj As Visio.shapes
Set shpsObj = ActivePage.shapes
Dim iShapeCount As Integer
iShapeCount = shpsObj.Count
'Assumes you want an array of shape data
Dim Storage() As String
ReDim Storage(iShapeCount - 1, 2)
'Visio shapes are 1 based so use full count
Dim i As Integer
Dim shpObj As Visio.Shape
For i = 1 To iShapeCount
Set shpObj = shpsObj(i)
Storage(i - 1, 0) = shpObj.Name 'Do you want NameU?
'Assumes you don't care whether the cell is local or inherited
If shpObj.CellExistsU("Prop.Name", visExistsAnywhere) Then
Storage(i - 1, 1) = shpObj.CellsU("Prop.Name").ResultStr("")
End If
If shpObj.CellExistsU("Prop.Description", visExistsAnywhere) Then
Storage(i - 1, 2) = shpObj.CellsU("Prop.Description").ResultStr("")
End If
Next
Dim j As Long
For j = LBound(Storage, 1) To UBound(Storage, 1)
Debug.Print "Shape Name- " & Storage(j, 0)
Debug.Print " Prop.Name- " & Storage(j, 1)
Debug.Print " Prop.Description- " & Storage(j, 2)
Next j
End Sub
If you're just running through all the shapes on the page, then you might want to look at For Each shp In shapes as an alternative. Check out this page for more details:
http://visualsignals.typepad.co.uk/vislog/2007/11/looping-through.html
Also, you might want to try look at the CreateSelection page method to narrow down your target shapes if you're dealing with a large number
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