So I have been trying to make every 3 words in a word docuemnt bold in a specific selection or if there is nothing selected every 3 words in the whole document. I tried different approaches but nothing worked.
I should say "What have you tried so far?" and "Lets see your code.", but I haven't really coded in Word so thought I'd give it a go....
This seems to do the trick, although there may be a much better way to code it:
Public Sub BoldText()
Dim wrd As Range
Dim x As Long
Dim doc As Variant
If Selection.Start = Selection.End Then
Set doc = ThisDocument
Else
Set doc = Selection
End If
x = 0
For Each wrd In doc.Words
x = x + 1
If x Mod 3 = 0 Then
wrd.Bold = True
End If
Next wrd
End Sub
Related
I wish to delete Simplified Chinese text in a document with both English and Chinese. The documents don't have any set pattern for which paragraphs are in which language.
I tried a few versions of code that search by paragraph and by language.
Sub DeleteCN()
iParCount = ActiveDocument.Paragraphs.Count
For J = 1 To iParCount
sMyPar = ActiveDocument.Paragraphs(J).Range.Text
If sMyPar.WdLanguageID = wdSimplifiedChinese Then
sMyPar.Delete
End If
Next J
End Sub
The error I get with this latest attempt is that an object is required on the If line.
You have a few issues with your code.
1) The most serious is you must reverse your loop. The loop must be reversed because as you delete a paragraph the number of paragraphs will dynamically change and then future paragraphs will no longer exist.
2) The rest are syntax errors, you can see where the syntax has been updated in the code. If you declare your variables it will be easier to know the correct syntax.
Sub DeleteCN()
Dim iParaCount As Integer
Dim para As Paragraph
iParaCount = ActiveDocument.Paragraphs.Count
For J = iParaCount To 1 Step -1
Set para = ActiveDocument.Paragraphs(J)
If para.Range.LanguageID = wdSimplifiedChinese Then
para.Range.Delete
End If
Next J
End Sub
Hope this helps.
The test code below examines paragraphs in ActiveDocument and puts 'copies' of unique paragraphs at the bottom of the document, followed by their original spacing blank paragraphs. Paragraphs are manipulated in an array, and qualifying paragraphs are then added one by one to the bottom of that document. Is there a faster way of adding those paragraphs there? I am hoping there is a way to add the array directly without needing the loop. I think that it is possible to assign an array to a range in Excel (see Rick Rothstein), but I can't see how to do that in Word 2010.
Sub FullArray()
Dim StartTime 'Start time
Dim p As Paragraph 'is each initial paragraph object in ActiveDocument
Dim pDict As New Scripting.Dictionary 'Keys=plain text versions of each inital para
'Items=signifiers of each key's (and para's)uniqueness or otherwise
Dim t As String 'Plain text version of each p, being a key of pDict
Dim pArray(1000) As Variant 'Contains all initial paragraph objects
Dim c As Integer 'c is ordinal number of each element of pArray
Dim dky As String 'dky is whichever element of pArray is to be used as a key of pDict
Dim pc As Integer 'running count of plain text paras in pDict
Dim lastdky As Integer 'signifies whether previous key of pDict is unique
'faster when dimmed, option explicit
StartTime = Timer
Application.ScreenUpdating = False 'Line 1 of Go to end of doc
ActiveDocument.Characters.Last.Select 'Line 2 of Go to end of doc. Is there a Faster way?
Selection.Collapse
'ADD each para object to Array. Write its plain text to dictionary...
'...in order to determine uniqueness of each para.
For Each p In ActiveDocument.Paragraphs
t = p.Range.Text
If Not pDict.Exists(t) Then
pDict.Add Key:=t, Item:=1 '1 flag means 1st instance of a para, including blamk paras
Else: pDict(t) = 2 '2 flag means a para which has duplicates
End If
pc = pc + 1 'count plain text paras in pDict
pArray(pc) = p 'set element number pc of Array = current paragraph object
Next p
'PLACE copies of certain paras at the end of document...
'...being those content-containing paras which were initially unique....
'...and place after each such para any following contiguous blank paras
lastdky = 1 '2/1 means PREVIOUS initial paragraph had/had not dupes.
For c = pc - 1 To 1 Step -1
dky = pArray(c)
If pDict(dky) = 1 And pArray(c) <> Chr(13) Then Selection.FormattedText = pArray(c) 'place para with content ('content paras') at end
If pArray(c) = Chr(13) And lastdky = 1 Then Selection.FormattedText = pArray(c) 'place (only) blank paras following content paras at end
If pDict(dky) = 2 Then lastdky = 2 Else: lastdky = 1
Next c
MsgBox "This code ran successfully in " & Round(Timer - StartTime, 2) & " seconds", vbInformation
Application.ScreenUpdating = True
End Sub
I'm looking for a way to have three different colors in the same line chart of a diagram in Excel, depending on the values themselves or where they are from (from which sheet f.e).
Till now, I have the following code:
Sub ChangeColor()
Dim i As Integer
Dim IntRow As Integer
Dim r As Range
ActiveSheet.ChartObjects("Cash").Activate
ActiveChart.SeriesCollection(1).Select
IntRow = ActiveChart.ChartObjects("Cash").Count
For i = 2 To IntRow
Set r = Cells(2, i)
If r.Value < 3000 Then
Selection.Border.ColorIndex = 5
Else
Selection.Border.ColorIndex = 9
End If
Next
End Sub
However, the if statement is not considered and the color of the whole line changes only whenever I change the first ColorIndex. I have no idea, how to color parts of the line depending on the values in the underlying table.
Moreover, by defining IntRow as ActiveChart.ChartObjects("Cash").Count I'm not able to get the length of my array. This problem can be solved by manual counting and declaring IntRow as an Integer, however, the version above seems nicer (if that is possible of course).
I appreciate any help! Thank you.
Alexandra
You can read the values directly from the chart series:
Sub ChangeColor()
Dim cht As Chart, p As Point, s As Series
Dim i As Integer
Dim numPts As Long
'access the chart directly - no select/activate required
Set cht = ActiveSheet.ChartObjects("Cash").Chart
'reference the first series
Set s = cht.SeriesCollection(1)
'how many points in the first series?
numPts = s.Points.Count
'loop over the series points
For i = 1 To numPts
Set p = cht.SeriesCollection(1).Points(i)
p.Border.ColorIndex = IIf(s.Values(i) < 3000, 5, 9)
Next
End Sub
I want to ask for a letter color in an If conditional:
string="asdfghjkl"
for i=1 to len(string)
letter = mid(string, i, 1)
input_letter = inputbox("Write a letter")
if letter = input_letter 'and letter.Font.Color = RGB(31,78,120)
'my code here
endif
next
The and letter.Font.Color = RGB(31,78,120) is not working. It says i need an object.
Is there any similar way to ask this? This RGB color is blue, and I am using this code to transform the entire sentence to blue (with the record macro excel setting)
With Selection.Font
.ThemeColor = xlThemeColorAccent1
.TintAndShade = -0.499984740745262
End With
Thanks
Regarding your question's problem:
The .Font.Color is a property of the class Range, but in your line of code:
if letter = input_letter 'and letter.Font.Color = RGB(31,78,120)
... you're trying to access this property in the variable letter, which is a String (you don't explicitly declare it as such, but it gets automatically declared when you execute letter = mid(string, i, 1) just above).
That is why you get an Object required exception: you're trying to access the property .Font.Color on something that is not a Range object (actually, not an Object at all).
Regarding your real need:
I'm not sure to understand what you're trying to do. Are you trying to reach a multi-colored text into a single cell in Excel? If I've got it right, you'll have a string:
string="asdfghjkl"
(please note: you can't call your variable String, that's a reserved keyword for the code. Think of calling it something else, though I guess you already do that in your real code or you wouldn't be able to execute it at all).
... and, for each letter of that string,
for i=1 to len(string)
... you want the user to give you a color. In that case, you can't do it in Excel. If not that, could you please express better your real need?
The code below comes closest to your OP logic and comment using the .Characters property of a cell Range (B11) containing your string value:
Code
Option Explicit
Sub test()
Dim blue As Long: blue = RGB(31, 78, 120)
Dim s As String: s = "asdfgh"
Dim letter As String
Dim input_letter As String
Dim i As Integer
Dim rng As Range
Set rng = ThisWorkbook.Worksheets("MySheet").Range("B11")
With rng
.Value = s
' color whole string
.Characters(1, Len(s)).Font.Color = blue
For i = 1 To Len(s)
letter = Mid(s, i, 1)
input_letter = InputBox("Write a letter")
If letter = input_letter And .Characters(i, 1).Font.Color = blue Then
'color found character
.Characters(i, 1).Font.Color = vbWhite
ElseIf input_letter = "" Then Exit For
End If
Next
End With
End Sub
Notes
Always use Option Explicitin your modules declaration head. So you would see that String isn't allowed as variable name as it's a function.
The extra color check in the If condition seems redundant, as characters so long a r e blue.
You seem to prefer repeated InputBoxes within the For - Next loop, could be reduced to a single call.
I am using VBA in Word 2016 and I want to create a rectangle the size of the paragraph (I can't use the border feature for other reasons).
I can get the position of the first character using this code, but what about the bottom and right end of the paragraph?
x = Selection.Information(wdHorizontalPositionRelativeToPage)
y = Selection.Information(wdVerticalPositionRelativeToPage)
Unfortunately, the following is just my wishful thinking:
w = Selection.Paragraphs(1).Width
h = Selection.Paragraphs(1).Height
In the end, I want to execute the following to generate a rectangle the same size as a bounding box around the paragraph:
ActiveDocument.Shapes.AddShape msoShapeRectangle, x, y, w, h
Any help would be appreciated. Thank you!
You are on the right track when you think in terms of the paragraph indicated by your selection. My preference is to deal with the range indicated by the selection, but that is a matter of personal preference. Anyway, the paragraph can be divided into - inter alia - a first character and a last character. As you have already stated, the fist character's position on the page is very near to the top left corner of your rectangle. A similar relationship can be established for the last character. The following code may help you on your way.
Private Sub TestPos()
Dim Rng As Range
Dim x As Single, y As Single
Set Rng = Selection.Range
Set Rng = Rng.Paragraphs(1).Range
With Rng
x = .Information(wdHorizontalPositionRelativeToPage)
y = .Information(wdVerticalPositionRelativeToPage)
Debug.Print x, y
.Collapse wdCollapseEnd
x = .Information(wdHorizontalPositionRelativeToPage)
y = .Information(wdVerticalPositionRelativeToPage)
Debug.Print x, y
Debug.Print .Paragraphs(1).LineSpacing
End With
End Sub
As for the left and right you should refer to the margins set for the paragraph. The following code contains the syntax you will need.
Private Sub ShowPageSetup()
Dim Rng As Range
With ActiveDocument.PageSetup
Debug.Print .LeftMargin, .RightMargin
End With
Set Rng = Selection.Range
With Rng.Paragraphs(1).Range.ParagraphFormat
Debug.Print .LeftIndent, .RightIndent
End With
End Sub