I'm fairly new to VBA coding. I am trying to capture a photo from a slide. The photo is outlined by a rectangle. There are text boxes and arrows inside the rectangle that I am trying to capture. I know I can group the object and export the shape as the group. It would be better for my situation if it was not necessary to group the objects. The current code does save a photo of the rectangle, but not the other shapes on top of it.
Dim photoA As Variant
Set photoA = Application.ActiveWindow.View.Slide.Shapes("Rectangle 2")
With photoA
.Export "A.jpg", ppShapeFormatJPG
End With
Related
I have small problem, does anyone know how to change position of existing dimensions and Notes in Part/Product using short macro.
I will shortly describe what I want to do and what kind of problem I have.
I have simple model (let say rectangle)
Inside this model I have dimensions and annotations created in FTA.
Next step is to drastically change position of this model (base model in point 0,0,0 and I want tochange it position to 150,10000,80 + rotation)
during this change some dimensions and annotations (Theirs position in 3D) are not fully following after geometry.
Because of that I would like to have simple macro to create new position of my dimensions and annotations after part update.
I have performed some simple tests code bellow
What I have noticed, when I set new position of the text:
Theoretically text change position but in 3D it stays in old position.
When edit my text by double click on it and then click OK my text translates to new position which was set in macro earlier. The same situation is when I would like to change frame of the text or content (I had AAA and I would like to have BBB), it's changes only when I open Text editor.
Set part1 = CATIA.ActiveDocument
Set Selection = part1.Selection
Set VisPropertySet = Selection.VisProperties
Selection.Search ("name='Text.1',all")
' get selected annotation here
Dim anAnnotation As Annotation
Set anAnnotation = CATIA.ActiveDocument.Selection.Item(1).Value
' get annotation on the DrawingText interface
Dim txtAnnotation As DrawingText
Set txtAnnotation = anAnnotation.Text.Get2dAnnot()
' get TPS view that contains annotation on the DrawingView interface
Dim vwTPSView As DrawingView
Set vwTPSView = txtAnnotation.Parent.Parent
' get coordinates on a view
Dim dX ' as Double
txtAnnotation.X = 0
txtAnnotation.Y = 30
txtAnnotation.FrameType = catEllipse
part1.Update
End Sub
Generally using Part.Update refreshes the annotation's position and text but you can also use:
Dim anAnnotation As Annotation
'Code here
anAnnotation.ModifyVisu 'This should work for both Texts and Dimensions
But if the above method does not work, you can try reseting the text on the annotation (It will work only for texts, and not for dimensions)
Dim vwTPSView As DrawingView
'Code here
vwTPSView.Text = vwTPSView.Text
Be carefull with this last methos though. If your text has any parameters or variables inside it, replacing the text will clear it.
I use the following VB.NET (VSTO) code to add a shape in MS-Word,
Dim app As Word.Application = Globals.ThisAddIn.Application
Dim doc As Word.Document = app.ActiveDocument
Dim left As Single = CSng(Convert.ToDouble(app.Selection.Information(Word.WdInformation.wdHorizontalPositionRelativeToPage)))
Dim top As Single = CSng(Convert.ToDouble(app.Selection.Information(Word.WdInformation.wdVerticalPositionRelativeToPage)))
Dim shape As Word.Shape = doc.Shapes.AddShape(1, left, top, 225.1F, 224.5F)
shape.Fill.BackColor.RGB = ColorTranslator.ToOle(Color.Transparent)
shape.Fill.Visible = Microsoft.Office.Core.MsoTriState.msoFalse
shape.Fill.Transparency = 0.0F
shape.Line.Transparency = 0.0F
shape.Line.Visible = Microsoft.Office.Core.MsoTriState.msoFalse
What this code does is, it adds a rectangle shape at cursor point and makes it transparent (both background and line).
Now I like to change the absolute positions' type. To explain further, when you select the rectangle shape, then if you select the Ribbon tab Format > Position > More Layout Options... as shown in the image below,
It will open the following dialog,
In the above dialog I like to change Column and Paragraph marked by the red rectangles into the type Margin. How to do this by code?
Word provides a Macro recorder. You may use it to get the code generated for you in the background. Thus, you will find what properties and methods exactly should be used to get the job done. See Record or run a macro for more information.
The solution to this was solved in the link below,
https://social.msdn.microsoft.com/Forums/vstudio/en-US/e69584d7-24fe-4396-9a82-26b7dae02584/word-vsto-change-the-absolute-positions-type?forum=vsto
I want to be able to change the image of an image shape by clicking on an button in my userform.
In the internet I found the function UserPicture, but the image simply stays the same.
Private Sub ChangeImage_Click()
ActivePresentation.Slides("Slide1").Shapes("SolutionA_Image").Visible = True
ActivePresentation.Slides("Slide1").Shapes("SolutionA_Image").Fill.UserPicture ("D:\User\Desktop\SolutionWrong.jpg")
End Sub
Private Sub HideImage_Click()
ActivePresentation.Slides("Slide1").Shapes("SolutionA_Image").Visible = False
End Sub
When I click on the HideImage button, the shape becomes invisible, so my selection of the shape appears to be right.
I also tried
ActivePresentation.Slides("Slide1").Shapes("SolutionA_Image").Fill.UserPicture "D:\User\SolutionWrong.jpg"
but this does not work either
Edit
Of course I checked the path to the new image, it's correct.
Siddharth Rout found the solution
I created the image by selecting picture from the insert menu, but it have to be created via Insert => Rectangular shape (no border). Now it can easily be accessed by using ActivePresentation.Slides("Slide1").Shapes("SolutionA_Image").Fill.UserPicture ("D:\User\SolutionWrong.jpg")
I am trying to generate a few hundred basic graphics where the shape text and background color is based on a text string.
For this i have chosen to use PowerPoint, because i feel that the image styling is quite comprehensive for my function. The only program that i know how to do this is Adobe Photoshop, however i do not have that software.
I have got the export image function to work, however the image quality of the exported graphic is terrible
How could i get this done with a better image processor?
As can be seen, i have a powerpoint slide with a textbox to hold the stringvalues (Rectangle 5) and my "shape" which will be styled by the two RGB values in the text string.
the string value has the following format (pipe delimited)
Textbox 4.Name | Rounded Rectangle 7.Color | Rounded Rectangle 3.Color
Code used:
Private Sub btnProcess_Click()
Dim i As Integer
Dim StringsArray As Variant
Dim StringItems As Variant
' Call getlines to break all lines into separate records in stringsarray
StringsArray = getlines()
For i = 0 To UBound(StringsArray)
StringItems = Split(StringsArray(i), "|")
ActivePresentation.Slides("Slide1").Shapes("TextBox 4").TextFrame.TextRange.Text = StringItems(0)
ActivePresentation.Slides("Slide1").Shapes("Rounded Rectangle 7").Fill.ForeColor.RGB = StringItems(1)
ActivePresentation.Slides("Slide1").Shapes("Rounded Rectangle 3").Fill.ForeColor.RGB = StringItems(2)
ActivePresentation.Slides("Slide1").Shapes("Group 6").Export "C:\temp\file.emf", ppShapeFormatEMF, 150, 150, ppRelativeToSlide
Next i
End Sub
Function getlines() As Variant
Dim mylines As Variant
Dim mytext As String
mytext = ActivePresentation.Slides("Slide1").Shapes("Rectangle 5").TextFrame.TextRange.Text
mylines = Split(mytext, vbCr)
getlines = mylines
End Function
The vector graphics based PPT object as seen on the PowerPoint slide is not affected by the scale so at all zoom level the object will not appear distorted.
I could not find a way to output the object graphic as a true Metafile even the ppShapeFormatEMF format does not generate a vector based EMF, just a much larger image.
My best solution at the end, was to increase the base size of the PPT object and export the shape object using the ppShapeFormatPNG format thereby increasing the level of detail of the image.
Kinda Obvious.
I want to insert a label into a PowerPoint presentation. But I don't want any background on there, or, have the background color be the same as the what is underneath.
I've found that 082F68 is the hex code I want. The RGB code is: 8, 47, 104
This color is supposed to be bluish, but when I insert it, it just gets brown.
I really don't want that. I also tried setting label.backcolor to Color.Transparent. But that isn't recognized. Neither is System.Drawing.Color.Transparent either. It just says it needs an object reference.
But really, isn't it possible to use direct hex values for label backgrounds?
(super late response, but in case others have this issue)
This will create a label on slide 1 in the upper-left hand corner. On my system, I get the bluish background color you are talking about.
ActivePresentation.Slides(1).Shapes.AddLabel(Orientation:=msoTextOrientationHorizontal, _
Left:=0, Top:=0, Width:=50, Height:=50).name = "TestLabel"
Dim sh As Shape
Set sh = ActivePresentation.Slides(1).Shapes("TestLabel")
sh.TextFrame.TextRange.Text = "Hello"
sh.Fill.BackColor.RGB = RGB(8, 47, 104)
You can also set the fill transparency to 100% (fill will be see-through):
sh.Fill.Transparency = 1#
I'm not sure what you're using as a "placeholder", but any Shape object will have an ID:
MsgBox "Label ID = " + CStr(sh.Id)
but it is probably easier to refer to it by name as I do above. The ID is a numerical value and isn't the same as the shape index, making it harder to reference the shape by its ID.
Above I programmatically assign the name, but you can also name the shape yourself: Home -> Arrange -> Selection Pane. In the selection pane you can click on the names of all the shapes on the slide to edit them. You can now refer to these shape names in code.
Try *.BackgroundColor = -1 'Transparent