Catia Listbox items - vba

I have this task where i need to find some type of hybridshapes and collect them in a listbox
i have done that part, but i need to create it in such a way that when user selects a item from the list box respective hybridshape or object should get selected in catia
here is the image
here is the code
Option Explicit
Dim ODoc As Document
Dim opartdoc As PartDocument
Dim oPart As Part
Dim ohybs As HybridBodies
Dim ohyb As HybridBody
Dim ohybshps As HybridShapes
Dim ohybshp As HybridShape
Dim i As Integer
Dim j As Integer
Private Sub UserForm_Initialize()
Set ODoc = CATIA.ActiveDocument
Set opartdoc = CATIA.ActiveDocument
Set oPart = opartdoc.Part
End Sub
Private Sub ListBtn_Click()
Set ohybs = oPart.HybridBodies
Set ohyb = ohybs.Item("Shapes")
Set ohybshps = ohyb.HybridShapes
For i = 1 To ohybshps.Count
Set ohybshp = ohybshps.Item(i)
ShapeBox.AddItem ohybshp.Name
ShapeBox.Font.Bold = True
ShapeBox.Font.Size = 25
Next
End Sub
Private Sub SelectBtn_Click()
End Sub
i dont know much about listbox handling
how do i create link between items in listbox and objects in catia
thanks

Hi you could add this to your code and try it. Beware your solution is pretty fragile one. You should consider more robust checks for objects validation
The trick lies in ShapeBox.Value in Shapebox click event. The rest is just catia stuff. But this solution is not foolproof because if you have more shapes with same names it might not select the right one. I would prefer creating a collection where you store real object from sets and the passing these objects to selection
Private Sub ShapeBox_Click()
Call opartdoc.Selection.Clear
Call opartdoc.Selection.Add(opartdoc.Part.FindObjectByName(ShapeBox.Value))
End Sub

Related

Running macro to specific style

Below code is trying to convert words in lowercase in to uppercase. However I only need to run it only in a specific word style ("Normal"). I tried to set doc to ActiveDocument.Styles("Normal") but i keep on getting error. Any help would be most helpful. Thank you in advance.
Option Explicit
Public Sub TitleCaseDocument()
Dim doc As Document: Set doc = ActiveDocument.Styles("Normal")
Dim wrd As Range
For Each wrd In doc.Words
If wrd.Text <> UCase$(wrd.Text) Then wrd.Case = wdTitleWord
Next
End Sub
The solution provided by #eaazel falls into the default member trap.
The code
wrd.Style
is in reality using the default member of the style object, which is 'NameLocal'. Thus the code implied by the code above is in reality
wrd.Style.NameLocal
Normally this would not be a problem, however, the level of granularity that is being used to extract the style object means that, on occasion, words with no style will be encountered (e.g. a ToC field). In such a case the style object returned is nothing and this generates a surprising error because you cannot call the NameLocal method on an an object that is nothing.
Therefore a more correct approach is to use a word unit that is guaranteed to have a style object (e.g. paragraphs) and to test for the style on this object before testing each word.
Option Explicit
Public Sub TitleCaseDocument()
Dim myDoc As Document: Set myDoc = ActiveDocument
Dim myPara As Range
For Each myPara In myDoc.StoryRanges.Item(wdMainTextStory).Paragraphs
If myPara.Style.NameLocal = "Normal" Then
TitleParagraph myPara
End If
Next
End Sub
Public Sub TitleParagraph(ByVal ipRange As Word.Range)
Dim myText As Range
For Each myText In ipRange.Words
If Not UCase$(myText.Text) = myText.Text Then
myText.Words.Item(1).Case = wdTitleWord
End If
Next
End Sub
Update 2020-Apr-16 Revised code below which has been proved to work on a Word document.
Option Explicit
Public Sub TitleCaseDocument()
Dim myDoc As Document: Set myDoc = ActiveDocument
Dim myPara As Word.Paragraph
For Each myPara In myDoc.StoryRanges.Item(wdMainTextStory).Paragraphs
If myPara.Style.NameLocal = "Normal" Then
TitleParagraph myPara
End If
Next
End Sub
Public Sub TitleParagraph(ByVal ipPara As Word.Paragraph)
Dim myText As Range
For Each myText In ipPara.Range.Words
If Not UCase$(myText.Text) = myText.Text Then
myText.Words.Item(1).Case = wdTitleWord
End If
Next
End Sub
So Do You want to change lowercase in to uppercase if style is normal?
Yes?
I don't have big experience with word but maybe something like this help you (base on your code):
Public Sub TitleCaseDocument()
Dim doc As Document: Set doc = ActiveDocument
Dim wrd As Range
For Each wrd In doc.Words
If wrd.Text <> UCase$(wrd.Text) And wrd.Style = "Normal" Then
wrd.Text = UCase$(wrd.Text)
End If
Next
End Sub

MS Visio Drop a custom shape using VBA

I can't seem to figure out how to drop a shape using VBA.
What I want to do is: The user opens a UserForm and enters something in the TextBoxes. When clicking on the commandbutton I want to load a Shape (i.e. ressource) from a custom stencil (i.e. shapes.vssx) write the User-Entries into the ShapeData (i.e. write a Name string in Props.Name) and then Drop it somewhere on the sheet. I know I have to use the Shape.Drop method but how do I reference the specific Master-Shape I want to use for creating the new shape?
So far I am trying with this
Private Sub CommandButton1_Click()
Dim shp As Visio.Shape
Dim page As Visio.page
Set page = Application.ActiveWindow.page
Set shp = Application.Documents.Item("shapes.vssx").Masters.ItemU("ressource")
page.Drop shp, 1, 1
End Sub
Which returns a type mismatch. What am I missing?
You're looking to drop a Master rather than a Shape so try this modification of your code (untested):
Private Sub CommandButton1_Click()
Dim mst as Visio.Master
Dim shp As Visio.Shape
Dim pag As Visio.page
Set pag = Application.ActiveWindow.Page
Set mst = Application.Documents.Item("shapes.vssx").Masters.ItemU("ressource")
'You might also want to add some checks that the target document and then master exist
Set shp = pag.Drop(mst, 1, 1)
End Sub

Check for the senderEmailAddress

I have a listener in VBA on my outlook box to perform an action if a receive a mail from a specific email.
The problem is that if I get a error mail (non-delivery email) then my condition is run on a mail which doesn't have that property so my method crashes.
I don't know what the subject may be either.
Does anyone have an idea if I can test if the property exists or if there is another property I can check for to identify if my sender matches?
Many thanks in advance
Sub SetFlagIcon()
Dim mpfInbox As Outlook.Folder
Dim obj As Outlook.MailItem
Dim i As Integer
Set mpfInbox = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Test")
' Loop all items in the Inbox\Test Folder
For i = 1 To mpfInbox.Items.Count
If mpfInbox.Items(i).Class = olMail Then
Set obj = mpfInbox.Items.Item(i)
If obj.SenderEmailAddress = "someone#example.com" Then
'Set the yellow flag icon
obj.FlagIcon = olYellowFlagIcon
obj.Save
End If
End If
Next
End Sub
Dim obj as a generic Object - there are objects other than MailItem in your Inbox, also to improve your loop try using Items.Restrict Method (Outlook)
Option Explicit
Sub SetFlagIcon()
Dim mpfInbox As Outlook.Folder
Dim obj As Object
Dim Items As Outlook.Items
Dim i As Long
Dim Filter As String
Set mpfInbox = Application.GetNamespace("MAPI").GetDefaultFolder _
(olFolderInbox).Folders("Temp")
Filter = "[SenderEmailAddress] = 'someone#example.com'"
Set Items = mpfInbox.Items.Restrict(Filter)
' Loop all items in the Inbox\Test Folder
For i = 1 To Items.Count
If Items(i).Class = olMail Then
Set obj = Items(i)
'Set the yellow flag icon
obj.FlagIcon = olYellowFlagIcon
obj.Save
End If
Next
End Sub
Items.Restrict Method Applies a filter to the Items collection, returning a new collection containing all of the items from the original that match the filter.

CorelDraw VBA macro error: "Object Required"

I am creating a macro for CorelDraw which will import a file from a given folder when a button called Generate is pressed. When trying to assign a filepath to a variable, I get the following error:
Object Required
Here's my code:
Private Sub UserForm_Initialize()
'Design Of Item'
Me.DesignList.AddItem ("BIFT")
Me.DesignList.AddItem ("BIFC1")
Me.DesignList.AddItem ("BIFC2")
Me.DesignList.AddItem ("BIFI")
'Type Of Item'
Me.TypeList.AddItem ("BIF HOODIE")
Me.TypeList.AddItem ("BIF T-SHIRT")
Me.TypeList.AddItem ("BIF SWEAT")
Me.TypeList.AddItem ("BIF TANK")
'Colours of the items'
Me.ColourList.AddItem ("Grey")
Me.ColourList.AddItem ("White")
Me.ColourList.AddItem ("Black")
Me.ColourList.AddItem ("Navy")
Dim Design As String
Dim Ctype As String
Dim Colour As String
Dim ShirtFPath As String
End Sub
Private Sub GenerateBtn_Click()
Set ShirtFPath = ("C:\Users\Matt\Pictures\Clothing Line\Shirts")
MsgBox (ShirtFPath)
Set Design = DesignList.Value
Set Ctype = TypeList.Value
Set Colour = ColourList.Value
End Sub
Private Sub SaveBtn_Click()
Dim fPath As Object
Dim sr As ShapeRange
Set fPath = Me.TB.Value
If fPath Is Nothing Then Exit Sub
End Sub
You only use Set for object assignment. For intrinsic types (numbers, strings, booleans), omit the word Set:
ShirtFPath = "C:\Users\Matt\Pictures\Clothing Line\Shirts"
Design = DesignList.Value
Ctype = TypeList.Value
Colour = ColourList.Value

VISIO count shapes in container

I'm pretty rusty with VBA and I was hoping someone could point me in the right direction, or help me out. What I'm trying to do is run a macro that will cycle through each active container on my sheet, and then count the number of shapes within that container. Then I'd like to update a field in the shape data for the container with the number of shapes.
This is what I have so far:
Public Sub countContainers()
Dim vsoPage As Visio.Page
Dim vsoDocument As Visio.Document
Dim vsoDocuments As Visio.Documents
Dim vsoPages As Visio.Pages
Dim vsoContainerShape As Visio.Shape
Dim containerId As Variant
For Each containerId In vsoPage.GetContainers(visContainerIncludeNested)
Set vsoContainerShape = vsoPage.Shapes.ItemFromID(containerId)
Debug.Print vsoContainerShape.NameU
Next
End Sub
The error I get is Object Variable or With Block variable not set
Any ideas?
The error is because you have declared the vsoPage but you never assigned it to any page in your document.
Add a line such as this to initialize it and the error goes away:
Set vsoPage = ActivePage