I have a issue to change all bold text withing a couple of cells to ALLCAPS (or even to a different alcaps font)
I saw a couple of similar modules but I am not an expert to change the condition and the loop.
(so change all words from bold to allcaps withing a selection - no full cells)
try this one, works pretty well for me. Below code changes every bold letter into uppercase:
Sub BoldToUpper()
Dim i As Integer
Dim cell As Variant
For Each cell In Selection
'Check each character of a string
For i = 1 To Len(cell.Value)
With cell.Characters(i, 1)
'Possible adjustment due to regional settings
If .Font.FontStyle = "Bold" Or .Font.FontStyle = "Bold Italic" Then
.Caption = UCase(.Caption)
'Possible adjustment due to regional settings
.Font.FontStyle = "Regular" 'Deletes bold effect
End If
End With
Next i
Next cell
End Sub
Note, that perhaps you may adjust the code to your local language settings.
For example in polish:
If .Font.FontStyle = "Pogrubiony" Or .Font.FontStyle = "Pogrubiona kursywa" Then
Related
In My Word Template I have few bullet points, and I will select the required points based on selection from the GUI and remove the rest of the points that are not selected from the code. So it depends on the user how many points that he would select.
I am Tall (bookmark1)
I am Dark (bookmark2)
I am 6.2 feet height (bookmark3)
I Have BMW (bookmark4)
I know 5 different languages (bookmark5)
I have created bookmarks for all these points as shown in the braces above.
Now the problem is, the user selects few number of bullet points from the above list and output would leave an extra blank line below.
I have tried many approaches from changing the selection of the bookmarks to adding bullet point form the code. I need to get rid of the extra blank line.
But nothing seems to work. I would appreciate the help in this. TIA
If .cboChanges1.Value = "No" Then
DeleteBookmark ("bookmark1")
Else
AddBullet ("bookmark1")
End If
If .cboChanges2.Value = "No" Then
DeleteBookmark ("bookmark2")
Else
AddBullet("bookmark2")
End If
etc.. where cboChanges1 and cboChanges2 are combo boxes to choose Yes/no.
Sub DeleteBookmark(strBookmark As String)
Dim rng As Range
Set rng = ActiveDocument.Bookmarks(strBookmark).Range
rng.Delete
Set rng = Nothing
End Sub
Before Screenshot
Output screen after first 3 options, you can see extra blank line as highlighted
I am adding the bullet point dynamically, as follows
Sub AddBullet(strBookmark As String)
ActiveDocument.Bookmarks(strBookmark).Select
Selection.Range.ListFormat.ApplyBulletDefault
End Sub
This is how the bookmarks are arranged,
A table cell always contains an end of cell marker which is a combination of paragraph and end of cell mark. This means that an empty cell always contains at least one paragraph.
As the end of cell marker cannot be deleted when you delete the text in the last bookmark you will get an empty paragraph because the previous bookmarked range ends with a paragraph mark.
You can deal with this in your DeleteBookmark routine by checking the length of the final paragraph of the cell. If it only contains two characters then it has no text and the preceding paragraph mark can be deleted.
Sub DeleteBookmark(strBookmark As String)
Dim rng As Range
Set rng = ActiveDocument.Bookmarks(strBookmark).Range
rng.Delete
Set rng = rng.Cells(1).Range.Paragraphs.Last.Range
If Len(rng.Text) = 2 Then
'paragraph contains no text so delete preceding paragraph mark
rng.Collapse wdCollapseStart
rng.MoveStart wdCharacter, -1
rng.Delete
End If
Set rng = Nothing
End Sub
If you are going to write code for Word you need to learn what the formatting marks are so that you can understand how a document is constructed.
FYI It is not necessary to select a range to apply bullets.
Sub AddBullet(strBookmark As String)
ActiveDocument.Bookmarks(strBookmark).Range.ListFormat.ApplyBulletDefault
End Sub
I have a word template with a 7x16 table and a default font size of 22. This template is used to generate a calendar for 16 weeks via a button click in ms Access. The calendar SHOULD make the month and day 22pt and the contents 7pt. This works for text, but not my dropdown lists (which should be 7pt font and italicized)
I tried using the following code to set the font size of the whole cell to 7pt, but it also set the month and day to 7pt as well:
'Dim DDown As Word.Contentcontrol and curChar As int earlier in code (for context)
Set cel = tbl.Cell(i, j)
Set celRange = cel.Range
celRange.Characters(curChar).Font.Size = 7 'This shrinks everything to 7pt
celRange.Collapse wdCollapseEnd
celRange.MoveEnd wdCharacter, -1
Set DDown = celRange.ContentControls.Add(wdContentControlDropdownList)
'Add items to dropdown
DDown.DropdownListEntries.Add "Shipping within 7 days"
DDown.DropdownListEntries.Add "On schedule"
DDown.DropdownListEntries.Add "On Hold"
Set celRange = cel.Range
celRange.Collapse wdCollapseEnd
celRange.MoveEnd wdCharacter, -1
celRange.Text = vbCrLf 'add a new line between dropdown lists
celRange.Collapse wdCollapseEnd
celRange.Select
Set DDown = Nothing
The line
celRange.Characters(curChar).Font.Size = 7
shrinks everything in the cell to 7pt font instead of just the dropdown list. I also would like to italicize the dropdown list. Is it the appearance property?
In order to apply a font change it's necessary to specify the exact Range to which it should be applied. In theory, that would be:
ContentControl.Range.Font.Size = 7
The DropDown content control appears to be a special case, however. In my tests, if I apply the font formatting directly to the content control it affects only the list of selections and the placeholder text. When an entry is selected, however, the formatting reverts to that of the surrounding text.
Further experimentation revealed that it's also necessary to create a character style in the document that contains the desired formatting. This needs to be applied to the content control and the direct formatting applied, as well.
Here's the code for applying the formatting
DDown.DropdownListEntries.Add "Shipping within 7 days"
DDown.DropdownListEntries.Add "On schedule"
DDown.DropdownListEntries.Add "On Hold"
DDown.DefaultTextStyle = "Test7"
DDown.Range.Font.Size = 7
DDown.Range.Font.Italic = True
where "Test7" is the style name I created in the test document.
If the style can't be pre-defined in a document it will need to be created on-the-fly. Here's some sample code for that. The following line should precede the loop (it needs to be executed only once), but follow code that opens/creates the Word document:
CreateFont7Style ActiveDocument, "DdFont7" 'If the code already has a Document object, use that, not ActiveDocument
(Remember to substitute the style name specified here for the style name in the line of code, above, that applies the style to the dropdown content controls!)
The code for CreateFont7Style (which you can name anything you want, just be sure to change the name in both places):
Sub CreateFont7Style(doc As Word.Document, styleName As String)
Dim st As Word.style
Dim fontSize As Long
Dim bItalic As Boolean
fontSize = 7
bItalic = True
Set st = doc.styles.Add(styleName, Word.WdStyleType.wdStyleTypeCharacter)
st.Font.Size = fontSize
st.Font.Italic = bItalic
End Sub
I am trying to create a Word macro that will go through a large document that I have and add the text "SAMPLE" to the beginning of every paragraph.
The document contains a Title page, Table of Contents and Headings throughout and I would prefer none of these have the "SAMPLE" text on them, just the paragraphs.
Below is some macro code I have found on various sites and kind of pieced together to do somewhat of what I want. It does place the "SAMPLE" text at the beginning of some paragraphs but not all, usually only the first paragraph of a new section within my document. And it also places it at the end of the Table of Contents and Beginning of the Title page.
I am brand new to macros in Word so any help is appreciated or if there is a better way of doing this perhaps? There might even be some unnecessary bits in this code since it is pieced together from other samples.
Sub SAMPLE()
Application.ScreenUpdating = False
Dim Par As Paragraph, Rng As Range
For Each Par In ActiveDocument.Paragraphs
If Par.Style = "Normal" Then
If Rng Is Nothing Then
Set Rng = Par.Range
Else
Rng.End = Par.Range.End
End If
Else
Call RngFmt(Rng)
End If
If Par.Range.End = ActiveDocument.Range.End Then
Call RngFmt(Rng)
End If
Next
Application.ScreenUpdating = True
End Sub
Sub RngFmt(Rng As Range)
If Not Rng Is Nothing Then
With Rng
.End = .End - 1
.InsertBefore "SAMPLE"
End With
Set Rng = Nothing
End If
End Sub
Provided your Title, Table of Contents and Headings etc. don't use the Normal Style - as they shouldn't - you really don't need a macro for this - all you need is a wildcard Find/Replace where:
Find = [!^13]*^13
Replace = SAMPLE: ^&
and you specify the Normal Style as a Find formatting parameter. You could, of course, record the above as a macro, but that seems overkill unless you're doing this often.
I have many occasions that I have to copy article from web-page, paste to word and format in a certain way. I had this code to auto paste and format. However, it only work once, and it just doesn't change the font of the pasted article later on.
Sub Macro1()
Dim artic As Word.Range
Set artic = Selection.Range
'keep bold word bold and avoid paragraphs to cluster into one
artic.PasteAndFormat (wdFormatOriginalFormatting)
'paste and select pasted article
artic.Select
artic.Font.Name = "Calibri"
artic.Font.Size = 10.5
artic.Font.Italic = False
artic.ParagraphFormat.Alignment = wdAlignParagraphLeft
End Sub
If you set a breakpoint at artic.Font.Name = "Calibri" so that the code stops after artic.Select you'll see that the Paste method does not include what's been pasted. Generally, artic will be at the beginning of the pasted content.
This means the code needs to be able to locate the position just after where the Selection was before pasting. It also depends on whether the paste occurs at the end of the document, or not.
The following sample code worked for me in my tests. It uses two Ranges: one for where the content will be pasted, the other for the end position after pasting.
(Responding to request for more clarification about the Word object model): Think of a Range object like a selection, with the difference that there can be many Range objects, but only one Selection. When manipulating a Range it often helps to think of using the keyboard to reduce or expand it. Pressing the left- or right-arrow keys will "collapse" a selection to an insertion point; holding Shift and pressing these keys will expand/reduce a selection; holding Shift while clicking somewhere else in the document will also do that. Think of setting Range.Start or Range.End as the equivalent of this last. The start or end point of the Range is being arbitrarily set to another location in the document.
In the case of the first If in the code below the Range is being reduced/collapsed to its starting point (think left-arrow key), then moved one character to the right (think right-arrow key). This puts it beyond where new material will be pasted, so extending the paste point's end to this Range's starting point will pick up everything between the two.
Sub TestPasteAndSelect()
Dim artic As Word.Range, rng As Word.Range
Dim bNotAtEnd As Boolean
Set artic = Selection.Range
Set rng = artic.Duplicate
rng.End = ActiveDocument.content.End
If rng.Characters.Count > 1 Then
'selection is not at end of document
rng.Collapse wdCollapseStart
rng.MoveStart wdCharacter, 1
bNotAtEnd = True
End If
'keep bold word bold and avoid paragraphs to cluster into one
artic.PasteAndFormat (wdFormatOriginalFormatting)
'paste and select pasted article
'artic.Select
'rng.Select
If bNotAtEnd Then
artic.End = rng.Start
Else
Set artic = rng.Duplicate
End If
artic.Font.Name = "Calibri"
artic.Font.Size = 10.5
artic.Font.Italic = False
artic.ParagraphFormat.Alignment = wdAlignParagraphLeft
End Sub
I'm programmatically filling in a regulated form template where lines are predefined (as table cells):
(Using plain text Content Controls as placeholders but this isn't relevant to the current question.)
So, I have to break long text into lines manually (auto-adding rows or something is not an option because page breaks are also predefined).
Now, since characters have different width, I cannot just set some hardcoded character limit to break at (or rather, I can, and that's what I'm doing now, but this has proven to be inefficient and unreliable, as expected). So:
How do I check if a Range of text fits on a single line -- and if it doesn't, how much of it fits?
I've checked out Range Members (Word) but can't see anything relevant.
The only way is to .Select that text, them manipulate the selection. Selection in the only object for which you can use wdLine as a boundary. Nothing else in the Word object model works with automatic line breaks.
Sub GetFirstLineOfRange(RangeToCheck As Range, FirstLineRange As Range)
'Otherwise, Word doesn't always insert automatic line breaks
'and all the text will programmatically look like it's on a single line
If Not Application.Visible Or Not Application.ScreenUpdating Then
Application.ScreenRefresh
End If
Dim SelectionRange As Range
Set SelectionRange = Selection.Range
Set FirstLineRange = RangeToCheck
FirstLineRange.Select
Selection.Collapse Direction:=wdCollapseStart
Selection.EndOf Unit:=wdLine, Extend:=wdExtend
Set FirstLineRange = Selection.Range
If FirstLineRange.End > RangeToCheck.End Then
FirstLineRange.End = RangeToCheck.End
End If
SelectionRange.Select
End Sub
Function IsRangeOnOneLine(RangeToCheck As Range) As Boolean
Dim FirstLineRange As Range
GetFirstLineOfRange RangeToCheck, FirstLineRange
IsRangeOnOneLine = FirstLineRange.End >= RangeToCheck.End
End Function
The subroutine GetFirstLineOfRange takes a RangeToCheck and sets FirstLineRange to the first text line in the given range.
The function IsRangeOnOneLine takes a RangeToCheck and returns True if the range fits on one line of text, and False otherwise. The function works by getting the first text line in the given range and checking whether it contains the range or not.
The manipulation of the Selection in GetFirstLineOfRange is necessary because the subroutine wants to move the end of the range to the end of the line, and the movement unit wdLine is available only with Selection. The subroutine saves and restores the current Selection; if this is not necessary then the temporary variable SelectionRange and the associated statements can be deleted.
Note:
There is no need to scroll anything - which in any event is not reliable. Try something based on:
With Selection
If .Characters.First.Information(wdVerticalPositionRelativeToPage) = _
.Characters.Last.Information(wdVerticalPositionRelativeToPage) Then
MsgBox .Text & vbCr & vbCr & "Spans one line or less."
Else
MsgBox .Text & vbCr & vbCr & "Spans more than one line."
End If
End With