I´m trying to create a code in vba excel to detect what´s inside the work flow objects - 3D as the ones shown in the following picture:
The pictures are always the same. I have been able to find and select the sentence inside the cell. But I need it to search for all the work flow objects in different visio.
This is where I got to:
Dim DiagramServices As Integer
DiagramServices = ActiveDocument.DiagramServicesEnabled
ActiveDocument.DiagramServicesEnabled = visServiceVersion140 + visServiceVersion150
Dim vsoCharacters1 As Visio.Characters
Set vsoCharacters1 = Application.ActiveWindow.Page.Shapes.ItemFromID(228).Characters
Debug.Print vsoCharacters1
I need the code to first find all the work flow objects in different pages in visio and then obtain the sentence within (vsoCharacters1)
Please try this simple code
Sub ttt()
Dim doc As Document ' Variable for Document
Dim pg As Page ' Variable for Page
Dim shp As Shape ' Variable for Shape
Dim txt As String ' Variable for Shape's text
For Each doc In Documents ' Iterate all documents in Visio application session
For Each pg In doc.Pages ' Iterate all pages in 'doc'
For Each shp In pg.Shapes ' Iterate all docunents in 'pg'
txt = shp.Text ' Define 'txt' variable
Select Case txt ' Criterion
Case "ololo", "trololo" ' Found text
ActiveWindow.Page = pg ' Activate page with criterion
ActiveWindow.Select shp, visSelect ' Select shape with criterion
MsgBox "Page: " & pg.Name & ", ShapeID: " & shp.ID, , "A shape was found, the text of which matches the criterion: " & txt
End Select
ActiveWindow.DeselectAll ' Unselect a shape
Next shp
Next pg
Next doc
MsgBox "TheEnd!!!"
End Sub
Note:
This code started in MS Visio, code without recursion, dont find shapes into groups !
May I propose a more systematic approach?
Drawing explorer
Make sure you're in developer mode.
Switch the drawing explorer on.
Identify the shape to explore
Expand its tree to see its sub-shapes
If you're lucky a pro has made this shape and named the subshapes eg Label, Frame, what ever. This will simplify the access to this shape.
in VBA:
shp being your group shape object
access the sub-shape via: set subshp = shp.Shapes(name_of_subshape)
This works also for the sub-shapes of the sub-shape.
Otherwise - the sub-shapes are named sheet.234 - you need to find another identification method.
Open the shapesheet of the sub-shape (right-mouse-click)
Inspect it and try to figure out in how far it differs from the other sub-shapes. That can be a text, user or prop field, a geometry section ... etc.
in VBA you would then loop over all the sub-shapes and check for this property.
eg:
for each subshape in shp.Shapes:
if subshape.CellExists("soAndSo",0) then
if subshape.Cells("soAndso").ResultStr("") = "thisAndThat" then
'you found it, do your stuff.
By the way, you don't need to access the characters object of a shape to get its text. It is simply "shp.Text". The characters object is more complexe and lets you do funny stuff with the text.
Related
I'm trying to use my company's software, Visio Standard, to create an entity relationship database using Excel. Usually the team has been creating this manually due to not having access to the Professional versions. With a mulitude of entities, the process is extremely tedious doing this one by one. I am trying to import from Excel to Visio without that pro version.
Theoretically the excel template would have Entity Name, Entity Structure (P'ship, Corp, DRE, Individual, ect.) and whatever else information needed to automatically populate into excel.
I have a background in VBA so that could be utilized, I just keep running into roadblocks due to the lack of tabs that the standard version has, including the main Data tab for import.
Is there any way I can import my data from Excel into Visio then run a code to convert it into shapes? What about my own custom template?
We make entity relationship diagrams often so one template would not work. We have a standard shapes & stencils that is used across the board, but the ERD is never the same. I thought I needed a template but I realized that I can't convert a personal template to a wizard or import an excel to the template that the template becomes quite useless.
#Surrogate My idea is that I want to pull the data from a template in excel to automatically create the ERD (or close to it) to save a large sum of time creating those entities through the shapes one by one. I think the template in Excel being so basic, with header columns for the Name of the Entity, Shape to use, hierarchy ladder; VBA does come into play pretty easily, just unsure how to mess around with that since I can't import excel into Visio through the standard version
#y4cine I am stuck because I cannot import data from excel in the standard version.
#TimWilliams I'm not capable of poaching to paying for the pro version, so regardless of the "fun" I would like to see if I could work around the pro version to do what the ERD/wizard can do, even if it requires a large VBA macro.
because I cannot import data from excel in the standard version
This example uses early binding.
In VBA you need to set a reference to the Excel Library.
It sets prop values in already existing shapes. The link being the shape ID.
If you rather need to draw new shapes, I' recommend using a master.
something like:
dim oMaster as master
dim oStencil as document
set oStencil = Application.Documents("myStencil")
set oMaster = oStencil.Masters("myMaster")
then inside the loop:
define some coordinates for x and y
set shp = activepage.drop(oMaster,x,y)
The function:
Public Function excelImport(filename As String) As Boolean
Dim xlsWorkbook As Excel.Workbook
Dim xlsSheet As Excel.Worksheet
Dim shp As Visio.Shape
Dim num_rows As Integer
Dim row As Integer
Dim shpID As String
Set xlsWorkbook = Excel.Workbooks.Open(filename)
Set xlsSheet = xlsWorkbook.Worksheets(1)
num_rows = xlsSheet.Range("A65000").End(xlUp).row
For row = 2 To num_rows
shpID = xlsSheet.Range("P" & row).FormulaR1C1
If Not shpID = "" Then
Set shp = ActivePage.Shapes.ItemFromID(CLng(shpID))
shp.Cells("prop.SoAndSo").Formula = Chr(34) & xlsSheet.Range("A" & row).FormulaR1C1 & Chr(34)
End If
Next row
xlsSheet.Application.Quit
Set xlsSheet = Nothing
Set xlsWorkbook = Nothing
excelImport = True
End Function
I have a userform in Excel 2016 that will generate a certain group of shapes (a welding symbol, if the context is helpful), mainly consisting of lines, arcs, and textboxes. Some of these will be the same every time the code is run, while others are options to be determined by the user via the userform. At the end those elements are grouped into a single symbol. My current code works as described thus far.
The problem comes when I try to run the form a second time (generating a second group of shapes independent of the first group). I have it set up such that as the code is executed, it creates a shape, names that shape appropriately, then groups all shapes at the end, referring to them by name. The second time the code is run, it uses the same names as in the first run. As soon as it tries to form the second group, I get an error due to names referring to two different shapes.
My question is this: Is there a way to add shapes to a group (or to a collection to be grouped later) as they are created? It seems naming shapes isn't the way to go, as the names are retained after the code ends. I tried referencing by shape index, but since I have images on the page as well, it's hard to determine exactly what a particular shape's index is. I apologize for the lack of code, as I don't have access to it right now. If needed I can write up something simple to get the point across. Any help is greatly appreciated!
You can group shapes with a command like this:
Dim ws as Worksheet
Set ws = ActiveSheet ' <-- Set to the worksheet you are working on
ws.Shapes.Range(Array("Heart 1", "Sun 2", "Star 3")).Group
(you can access the shapes via name or via index). The result of the group command is another shape that is added to the sheet. But be aware that the grouped shapes still exists in the sheet, you can access them with the GroupItems-property.
With ws.Shapes
Dim shGroup As Shape, sh As Shape
Set shGroup = .Range(Array("Heart 1", "Sun 2", "Star 3")).Group
shGroup.Name = "MyNewGroup" & .Count
For Each sh In shGroup.GroupItems
Debug.Print sh.Name, sh.Type
Next sh
End With
As you can see, the single shape elements don't change their names, so grouping would not solve your naming issue. The only way is to add a suffix to the name, e.g. a number (as Excel does it when it creates a shape).
Update: Of course the Array- parameter does not need to be static. You can declare an array that is large enough (it doesn't matter if it contains some empty elements).
Const maxShapes = 12
Dim myShapes(1 to maxShapes) as String
myShapes(1) = *Name of first shape you created*
myShapes(2) = *Name of second shape you created*
...
ws.Shapes.Range(myShapes).Group
or use the Redim command:
Dim myShapes() as String
Redim myShapes(1 to NumberOfShapesInYourNewGroup)
myShapes(1) = *Name of first shape you created*
myShapes(2) = *Name of second shape you created*
...
ws.Shapes.Range(myShapes).Group
To get a unique shape and group name, you can implement various methods. I don't like the attempt with a global variable as they might get reset - for example when you cancel execution during debugging. You could use for example the suffix that Excel generates when you create a new shape. Or put the rename-statement into a loop, put a On error Resume Next before the rename (and don't forget to put an On error Goto 0 after it) and loop until renaming was successfull. Or loop over all shapes in your sheet to find the next free name.
After some trial and error, the solution I came up with is something like the following.
'Count shapes already on sheet
Shapesbefore=ActiveSheet.Shapes.Count
'Create new shapes
'Create array containing indexes of recently created shapes
Dim shparr() As Variant
Dim shprng As ShapeRange
ReDim shparr(Shapestart + 1 To ActiveSheet.Shapes.Count)
For i = LBound(shparr) To UBound(shparr)
shparr(i) = i
Next i
'Group shapes and format weight/color
Set shprng = ActiveSheet.Shapes.Range(shparr)
With shprng
.Group
.Line.Weight = 2
.Line.ForeColor.RGB = 0
End With
This way I don't have to worry about creating and managing various group and shape names, as I don't need to go back and reference them later.
I'm developing an Excel Add-in using VSTO on vb.Net, where I'm struglling to get the names of the existing controls of a worksheet. In this project I'm adding two types of controls, a TableLayoutPanel and a NamedRange.
I loop the existing worksheet controls and I'm abble to get the type of the control, and in case of it be a NamedRange control I'm successfully getting its reference cell. Notwithstanding, I'm not able to get the name of both control types.
How can I get the name of the controls ?
The code bellow is where I'm creating the controls:
`Dim painel = New System.Windows.Forms.TableLayoutPanel
Dim changesRange As Microsoft.Office.Tools.Excel.NamedRange
Dim nomes As Microsoft.Office.Interop.Excel.Names = Globals.ThisAddIn.Application.ActiveWorkbook.Names
PanelsID += 1
changesRange = ws.Controls.AddNamedRange(range, CStr("NamedRange_" & PanelsID))
ws.Controls.AddControl(painel, range, "Panel" & PanelsID)
Dim name1 As Excel.Name = CType(changesRange.Name, Excel.Name)
'I could get the name of the control here
MessageBox.Show(name1.Name)`
The code bellow is where I'm looping the existing worksheet controls:
Function lerRange(ws As Microsoft.Office.Tools.Excel.Worksheet, range As Excel.Range) As Boolean
Dim wsControls As Integer
wsControls = ws.Controls.Count
For i = 0 To wsControls - 1
'Image1
MsgBox(ws.Controls(i).GetType.ToString)
If InStr(ws.Controls(i).GetType.ToString, "NamedRange") > 0 Then
'Image2
MsgBox(ws.Controls(i).RefersTo)
'Image3
MsgBox(ws.Controls(i).name.ToString)
Else
'Image4 - Using property name without toString()
MsgBox(ws.Controls(i).name)
End If
Next
lerRange = False
End Function
Output Image1 - Type of the control
Output Image2 - Refering range of the NamedRange control
Output Image3 - Output name of the control
Output Image4 - Error message
Thanks in advance to the ones who could help !
The Name property of NamedRange control has a capitel letter on the start and is an object. So you can try to get the name like this example.
...
For i = 0 To wsControls - 1
If InStr(ws.Controls(i).GetType.ToString, "NamedRange") > 0 Then
...
MsgBox(ws.Controls(i).Name.name)
...
End If
Next
...
More informations do you get at microsofts docs for NameRange.Name property.
After a Paste special linking of a range of cells from Excel to Word (2013) the field looks like this:
{ LINK Excel.SheetMacroEnabled.12 D:\\20181228\\SC.xlsm Sheet1!R10C1:R10C20" \a \p }
If you click on the object with the right button, select "Format object" and then click on "?", the Format AutoShape reference article opens.
However, ActiveDocument.Shapes.SelectAll does not detect this object.
This code also does not work, although the error message says that this component is available for pictures and OLE objects:
With ActiveDocument.Shapes(1).PictureFormat
.ColorType = msoPictureGrayScale
.CropBottom = 18
End With
What is this object?
I cannot find it in Object model (Word).
How to access it through VBA?
I want to programmatically resize a group of such objects to 90% of the original.
Upd. #Cindy Meister suggested where to dig, thanks.
I wrote the code, it seems to work fine:
Sub ResizeImages()
Dim img As Long
With ActiveDocument
For img = 1 To .InlineShapes.Count
With .InlineShapes(img)
.ScaleHeight = 90
.ScaleWidth = 90
End With
Next img
End With
End Sub
A Link field must be an InlineShape - it can't be a Shape, not if you can display the field using Alt+F9. Since Shape objects have text wrap formatting any field codes associated with them (usually none) aren't accessible.
Therefore, any object that's displayed via a Link field should be available via the InlineShape object model.
For example, the following code loops the fields in the document and, if they're link fields with an Excel source and contain an InlineShape, the InlineShape's dimensions are scaled:
Dim fld as Word.Field
For Each fld In ActiveDocument.Fields
If fld.Type = wdFieldLink
If fld.Result.InlineShapes.Count > 1 And _
InStr(fld.OLEFormat.ClassType, "Excel") Then
Set ils = fld.Result.InlineShapes(1)
ils.ScaleWidth = 90
ils.ScaleHeight = 90
End If
End If
Next
I'm using vba to create an excel document and fill it in dynamically (already completed and working perfectly). What I need is: to figure out how to add, size, position, and prefill (suggested signer, email, but not the signature itself) the signature block at multiple locations in this document.
I don't even know if this can be done with vba (my searches on the subject have been unhelpful), but I'm hopeful as it will save me a lot of time and tedious work in the future. Any help on this would be welcome.
You may want to place simple text boxes across defined cells (as anchor points) and fill it with some text. To get you started here's the bare minimum that you need:
the actual text box creating Sub which takes all info as parameters:
Sub CreateShapeText(NailToCell As Range, w_pt As Single, h_pt As Single, DTxt As String)
Dim TB As Shape
' create a text box shape
' note: shapes belong to worksheets, therefore we derive a WS from cell.parent
Set TB = NailToCell.Parent.Shapes.AddLabel(msoTextOrientationHorizontal, NailToCell.Left, NailToCell.Top, w_pt, h_pt)
' make its border visible
TB.Line.Visible = msoTrue
' switch off that annoying auto-resize when text is entered
TB.TextFrame2.AutoSize = msoAutoSizeNone
' enter text ... and yes - this object tree is crazy
TB.TextFrame2.TextRange.Characters.Text = DTxt
' as it should be - text is vertical bottom
' but to have more control over the TB, this could be a parameter, too
TB.TextFrame2.VerticalAnchor = msoAnchorBottom
End Sub
and you would call that from wherever in your code as in below example
Sub CallCreate()
CreateShapeText [A1], 132, 32, "sign: me"
CreateShapeText [C12], 132, 32, "sign: you"
End Sub
You take it from here and research what these objects can do for you (e.g. make dotted lines instead of solid for the frame, experiment with font sizes, alignments etc.) and come back with more questions in case ...