I have Shapes/Lines I need to recolor.
The problem I encounter is I can't just highlight everything and change line color, or Text Shapes that have no line color will then also now have lines.
How can I either take 2 reference variables for the select color and the recolor, or have the select color based off a currently selected object.
I want to recolor everything from Green to Black.
This is what I hashed together from other guides on the web. It selects objects without lines still (not a lot but some) and won't target anything that's within a group.
Sub Test()
Dim s As Shape
For Each s In ActivePage.Shapes
If s.Cells("LineColor").ResultStr(0) = "RGB(0, 176, 80)" Then
ActiveWindow.Select s, visSelect
End If
Next
End Sub
ActiveWindow.Select s, visSelect
This line just select shape, not change its color, try use this line
s.Cells("LineColor").FormulaU = "0"
If you need change shapes into group you must use recursive algorithm
Related
I wrote some macro code in Word (Office 365) to set the color of a shape outline to one of the theme colors. The code for doing that to a shape looks like this:
shape.line.foreColor.ObjectThemeColor = wdThemeColorAccent2
By assigning a 'wdXX' color to the ObjectThemeColor field, the color of the line around the shape will automatically change when the document ColorTheme is changed.
My problem (or the first weirdness) is that when I assign Accent2 with the code above and then do: select the shape, Menu, Format, Shape Outline, and hover over the color box with a red outline (which marks the active line color), the tooltip says "Turquoise, Accent 1" not "Accent 2."
I would have expected the wdThemeColorAccent2 color to be called Accent 2 in the tooltip, but it is not.
The second problem is that there is apparently no way for me to assign the last color shown in the menu using macro code. Because of the offset (Accent 2 in code = Accent 1 in the menu), I would need to use wdThemeColorAccent7 in code to assign the last color shown in the menu (labeled Accent 6 in the tooltip).
I'm wondering if this is a bug in Word (it sure looks like it to me), or if I am doing something wrong. To reproduce the situation, I created a simple empty rectangle, selected it, and ran the line of code above to change the outline color of the shape. Here's a little subroutine that illustrates the problem (select your shape before running the subroutine).
Sub TestAccent()
Dim shp As Shape
Set shp = selection.ShapeRange(1)
shp.line.foreColor.ObjectThemeColor = wdThemeColorAccent4
shp.line.Weight = 0.5
shp.line.Visible = True
End Sub
I believe the colors in the "theme scale" (see image below) don't correspond to the names of the WdThemeColorIndex, but rather to the underlying numerical value. If you look in the VBA Editor's Object Browser (F2), and search wdThemeColorAccent you'll get the full list. Click on a member in the list and at the bottom you'll see the numerical value.
The value 0 is assigned to MainDark1 and isn't recognized by VBA. Values 1, 2 and 3 are assigned to MainLight1, MainDark2 and MainLight2 which are black, white and the first entry in the image (These colors repeat in the last four enumerations for background and text). Values 4 (wdThemeColorAccent4) through 9 (wdThemeColorAccent6) correspond to the remainder of the colors in the image below. (Note: more discussion after image!)
So, no, I don't think it's a bug, just your expectations don't match what the developers were thinking when they assigned the numerical enumeration to the enumeration names. Or maybe the people who designed the color schemes changed their minds after the VBA code was locked down... And I imagine the names you see in the tooltips are another step removed from the VBA. You might find the information in this article helpful.
If you use the values, rather than the names, things could be less confusing. Or, define your own Enum:
Public Enum ColorSchemeAccents
Accent1 = 3
Accent2 = 4
Accent3 = 5
Accent4 = 6
Accent5 = 7
Accent6 = 8
Accent7 = 9
Accent8 = 10
End Enum
Sub TestAccent()
Dim shp As Shape
Set shp = Selection.ShapeRange(1)
shp.Line.ForeColor.ObjectThemeColor = ColorSchemeAccents.Accent8
shp.Fill.ForeColor = RGB(250, 250, 250)
shp.Line.Weight = 2
shp.Line.Visible = True
End Sub
Although the ColorFormat object's .ObjectThemeColor is defined as a wdThemeColorIndex in fact the value depends on context.
If it is a Word object - such as text, then you should use the wdThemeColorIndex constants, but if it is an Office object - such as shape, then you have to use the msoThemeColorIndex constants. These are weirdly NOT the same - mostly the mso constants are one more than the wd constants, but not for the Background1&2 and Text1&2 cases - Text1&2 are the same in both cases, but for Background1&2 mso is two more than wd.
A side effect of this is that it appears impossible in VBA to set the Background2 colour, as its mso value is 16 and so out-of-range BUT if you use the native GUI to set it, it can be set to 16!
Looks really poor design/implementation that needs cleaning up!
Is there a way to count number of rows of texts inside a Visio shape? Such as linecount?
I've tried Rowcount on a Visio shape and it didn't return anything reflecting the text lines inside the Visio Shape! Below is that sample code I created
Sub something()
Dim intRows
Dim vsoShape As Visio.Shape
Set vsoShape = ActiveWindow.Selection.PrimaryItem
intRows = vsoShape.RowCount(Visio.visSectionProp)
MsgBox intRows
End Sub
There is no built-in way to count the number of lines of text, that I'm aware of.
The RowCount is for counting the number of rows in a particular shapesheet section.
You can call the BoundingBox method on a shape and get back the height and width of the text area for the shape, but you'd have to guess at how many lines that is, maybe as a function of the font size.
If you are able to enforce a standard font and character size on shapes in the diagrams you're working with, you should be able to tell how many lines there are based on the height of the text box.
I'm assuming you're asking after the number of line wraps that Visio has done, not the number of line breaks in the text.
I need to know is selected shape word art or not.
Shape has property "Type" (returns enum MsoShapeType).
When I insert word art and check this property - it returns msoAutoShape instead of msoTextEffect (with AutoShapeType==msoShapeRectangle).
How can I check that spae is word art (not usual rectangle with textbox) ?
Thanks!
If you select either the overall smartart shape or click into text within the smartart shape or select one of the shapes within the smart art, ActiveWindow.Selection.ShapeRange(1) will return the smartart shape.
So
If ActiveWindow.Selection.ShapeRange(1).HasSmartArt Then
Debug.Print "It's smart art"
End if
[edited]
But as you've pointed out, this is for smartart, not word art. My error, sorry.
There isn't a WordArt shape as such; it's more like any shape that has had WordArt formatting applied to the shape as a whole or to text within the shape. That'd include formatting like glow, reflection, shadow and so on, or could be one of the WordArt presets, pre-selected combinations of these different effects. I've added an example that'll help identify shapes or ranges of text within shape that have these presets applied. I don't see any simple way of checking for user-applied WordArt formats other than looking at each run and each text box for each of the various properties (glow, reflection etc) that might be applied. Unfortunately, there's no WordArtFormat = None to tell us we can ignore it. It's either going to be one of the presets or -2, which can mean any of several things.
Sub WordArtist()
Dim oSh As Shape
Dim oRng As TextRange2
' Has word art formatting been applied to
' entire shape?
Set oSh = ActiveWindow.Selection.ShapeRange(1)
Debug.Print oSh.TextFrame2.WordArtFormat
' Has it been applied to individual chunks of
' text within the shape
For Each oRng In oSh.TextFrame2.TextRange.Runs
Debug.Print oRng.Font.WordArtFormat
Next
' Note:
' A result of -2 for the entire shape could mean
' - No text in the shape; not really word art
' - Mixed formatting
' - Text/shape has had glow/shadow/reflection etc applied
' rather than one of the preset WordArt selections
End Sub
I am trying to create a new PowerPoint plug-in. I have run into a problem for a case where I want to determine if for a given shape on slide 1, whether the same shape also exists on the next slide.
Is there a way by which I can compare shapes from different slides and determine whether they are the same?
I can probably compare the type, dimensions, text and other similar properties, but this may not be the right way to solve this problem. Is there a better way to do this?
Something like this will return an "identical" shape from another slide if it meets your criteria. You could have it return True/False instead if you prefer:
Function SameShape(oThisShape As Shape, oOtherSlide As Slide) As Shape
Dim oSh As Shape
For Each oSh In oOtherSlide.Shapes
If oSh.Type = oThisShape.Type Then
If oSh.Height = oThisShape.Height Then
If oSh.Width = oThisShape.Width Then
' other conditions here as required
Set SameShape = oSh
Exit Function
End If
End If
End If
Next
End Function
One caveat: if the shape's .Type = msoPlaceholder, you'll also need to look to see whether .PlaceholderFormat.ContainedType is the same.
What is an "identical" Shape for you?
All shapes hafe different IDs so you cannot compare them, but you could compare the Size, the location (Shape.Width, Shape.Height etc.) and maybe the content (a chart, a table or text?).
If enough Properties are equal they might be considered as equal.
I was wondering how to attach a textbox to a point or line in an Excel chart for the macro I am working on. I have been using the .AddTextbox method such as
.Shapes.AddTextbox(msoTextOrientationHorizontal, 150, 250, 100, 15) _
.TextFrame.Characters.Text = "Temperature"
But I have to then manually drag the textbox over the line on the chart it is representing as the orientation is of the chart not the line. Is there a way to convert the line/point to a chart orientation which I could use as a variable? or another way? Possibly using the datalabel function, though I want to be able to customize one of the axis locations. Thanks
To solve your question you need to get the left & top position of two objects:
chart itself, which position is set in relation to top-left corner of sheet range area
point in series which position is set in relation to top-left corner of chart
Combination of both result with the following code (fixed parameters-required changes to your situation, could be more dynamic with loop)
Sub Add_Text_to_point()
Dim tmpCHR As ChartObject
Set tmpCHR = Sheet1.ChartObjects(1) 'put index of your chartobject here
'for first serie, for point 2nd here
'(change accordingly to what you need)
With tmpCHR.Chart.SeriesCollection(1).Points(2)
Sheet1.Shapes.AddTextbox(msoTextOrientationHorizontal, _
.Left + tmpCHR.Left, _
.Top + tmpCHR.Top, _
100, 15) _
.TextFrame.Characters.Text = "Temperature"
End With
End Sub
After result presenting the picture below.
Another option would be to use the data labels of Excel. I see two more elegant options:
Make a new data series with just one entry in your chart, give the series the coordinates and the name of the label you want to see. Now activate the marker option for the series (if not done already), right-click on the data point, click "add data labels". Now you'll see the y-Value of the point. By right-clicking again and choosing "Format Data Labels" you can change the text to the series name, also the position, the border, etc. are modifiable. Below an example with two data points. You could delete the second point, the line and the marker but like this you see how it works.
Similarly to the solution from KazJaw you can use the actual data points of your series for attaching custom data labels. This requires some coding, I used this for the chart named "Topview" and wrote percentages next to the data point
Sub Add_Text_to_data_points()
percentages(1) = 0.1
percentages(2) = 0.23
'.... further entries
chartNumber = findChartNumber("Topview")
collNumber = 12 ' index of the "points" series
Set tmpCHR = ActiveSheet.ChartObjects(chartNumber)
For i = 1 To tmpCHR.Chart.SeriesCollection(collNumber).Points.count
With tmpCHR.Chart.SeriesCollection(collNumber).Points(i)
If percentages(i) <> 0 Then
.DataLabel.Text = format(percentages(i), "0%")
End If
End With
Next
End Sub