I want to insert text with custom formatting, then change the font style back to what it was before the code was run.
Dim myText As String
Dim oldFont As Object
'Save old font
Set oldFont = Selection.Font
'Insert text with custom font
myText = "CUSTOM STRING"
Selection.Font.Name = "Comic Sans MS"
Selection.Font.Size = 26
Selection.Font.Bold = True
Selection.TypeText (myText)
'Revert font back to original
Set Selection.Font = oldFont
Can anyone explain a way to do what I'm looking for?
Edit: I should have been more specific. If I am typing text, I have a certain formatting that I am typing in that is shown on the Home Tab (eg. Comic Sans Ms, Size 22, Bold). When I insert text with the code, this changes the formatting that I am typing with, so if I continue typing it will be in the NEW font type, not the Comic Sans MS. I am trying to make it so if I continue typing after I have inserted the text via VBA code, it will retain my old formatting.
One simple solution is to store all properties that you are going to change, and to reset them at the end:
Dim myText As String
Dim oldFont As String
Dim oldSize As Integer
Dim oldBold As Boolean
'Save old font
oldFont = Selection.Font.Name
oldSize = Selection.Font.Size
oldBold = Selection.Font.Bold
'Insert text with custom font
myText = "CUSTOM STRING"
Selection.Font.Name = "Comic Sans MS"
Selection.Font.Size = 26
Selection.Font.Bold = True
Selection.TypeText (myText)
'Revert font back to original
Selection.Font.Name = oldFont
Selection.Font.Bold = oldBold
Selection.Font.Size = oldSize
The trick I find helpful when writing Word macros is simply to replicate what I'd be doing if I was using the Word GUI. When I want to paste formatted text but keep my current format, I type a space, paste in the text before the space then delete the space. As the space has my original format that's how I get it back.
So, doing this as a macro:
'Type a space
Selection.TypeText Text:=" "
'Move Cursor back one character
Selection.MoveLeft Unit:=wdCharacter, Count:=1
'Insert text with custom font
myText = "CUSTOM STRING"
Selection.Font.Name = "Comic Sans MS"
Selection.Font.Size = 26
Selection.Font.Bold = True
Selection.TypeText (myText)
'Move Cursor forward one character
Selection.MoveRight Unit:=wdCharacter, Count:=1
'Delete the space
Selection.TypeBackspace
This will preserve any properties of the text you originally had.
I can't quite figure out exactly what you're trying to do there, but Selection.TypeText will collapse the selection down to the insertion point, so you effectively have no characters selected by the time you try to "revert the font". You either need to re-select the text, or use a Range object instead of the Selection to identify the text to be affected.
The reason that you get an error at the line:
Set Selection.Font = oldFont
...is because - unusually, and perversely - you should not use the Set keyword when assigning to the Font property. Rather than storing a reference to a Font object, the assignment simply applies the properties of the assigned font.
This is very confusing API design, made all the more confusing because you do need to use the Set keyword when reading the Font property, and because that does assign a reference to a Font object!
And that's the other reason why your code won't work - you're taking a reference to a Font object which you then modify, and your reference points to the same Font object that has now changed.
What you actually need to do is create a new Font object to store the original font details, as follows:
Set oldFont = Selection.Font.Duplicate
The Selection.Font object is read only.
This means that there is no way to restore all the settings in one assignment. Since you are only changing a few properties the easiest solution is to save each individual value and restore them afterwards as stephan suggests.
I.e. Save properties:
oldFontName = Selection.Font.Name
oldFontSize = Selection.Font.Size
oldFontBold = Selection.Font.Bold
Do you stuff and then restore properties:
Selection.Font.Name = oldFontName
Selection.Font.Size = oldFontSize
Selection.Font.Bold = oldFontBold
See, if this piece of code gives you enough hint.
CopyFormat picks up the existing formatting by moving left from current cursor.
PasteFormat applies it to a character & from there on, the original formatting (which was copied) comes into effect.
Selection.MoveLeft unit:=wdWord, Count:=1
Selection.EndKey Extend:=wdExtend
Selection.CopyFormat
Selection.MoveRight unit:=wdWord
'* New text and new formatting
Selection.Font.Bold = True
Selection.Font.Italic = True
Selection.Font.Size = 28
Selection.TypeText "hello world"
Selection.TypeText " "
Selection.MoveLeft unit:=wdCharacter, Count:=1
Selection.EndKey Extend:=wdExtend
Selection.PasteFormat
Selection.TypeText "original formatting here"
Sub No_Format()
'
' No_Format Macro
'
'
Selection.PasteSpecial Link:=False, DataType:=wdPasteText
End Sub
this will allow you to paste the text and adopting the new formatting.
Related
I'm using this macro to clear all text format and paste it to another document:
Selection.Copy
Windows(1).Activate
Selection.PasteAndFormat (wdFormatPlainText)
It works fine, but I need plain text with information about bolded characters as red color. In other words - I need to remove all text formatting but make bolded characters red.
I was trying to iterate Selection char by char, but without success.
remove all formatting is impossible but set style to normal can.
Selection.Copy
Windows(1).Activate
Windows(1).Document.Bookmarks.Add ("xx")
Selection.PasteAndFormat (wdFormatPlainText)
Windows(1).Document.Bookmarks.Add ("xxx")
Selection.Start = Windows(1).Document.Bookmarks.Item(1).Start
Selection.End = Windows(1).Document.Bookmarks.Item(2).Start
Selection.Style = wdStyleNormal
Selection.Font.Bold = True
Selection.Font.Color = wdColorRed
Windows(1).Document.Bookmarks.Item(1).Delete
Windows(1).Document.Bookmarks.Item(1).Delete
I am trying to insert a new page in word i.e insert a section break. The problem is that i want to change this page to A3 landscape and remove all headers, which my code currently does not do. How to modify my code below to achieve this?
Below is my current code that insert new page, but keeps the header and a4 portrait:
If wordDrawingExist Then
Selection.EndKey Unit:=wdStory
Selection.InsertFile FileName:=wFile, link:=False
Set wb = Documents.Open(wFile)
Selection.WholeStory
Selection.Copy
Documents(docLogSkjema).Activate
Selection.EndKey Unit:=wdLine
Selection.InsertBreak Type:=wdPageBreak
Selection.Paste
wb.Close False
End If
wFile is fullpath to a wordfile, which is basically a pdf to word from freepdfsolutions.com (Tried inserting the pdf directly but then the quality of the pdf was so bad that numbers were hard to read) and wordDrawingExist is the boolean saying if the wordfile exist or not
OK, first of all, you will need a section break, not a simple page break:
Selection.InsertBreak Type:=wdSectionBreakNextPage
To change to landscape orientation:
Selection.PageSetup.Orientation = wdOrientLandscape
Make sure you are in the section you want to change. Note that after inserting the section break, the cursor will be in the new section.
To change the size to A3, you will need to set the size manually:
With Selection.PageSetup
.PageWidth = CentimetersToPoints(42)
.PageHeight = CentimetersToPoints(29.7)
End With
To delete the header:
selection.Sections(1).Headers(wdHeaderFooterPrimary).Range.Delete
Your selection doesn't include multiple sections, so from the one section it touches, you need the first (duh) hence the Sections(1).
Put it all together:
Selection.InsertBreak Type:=wdSectionBreakNextPage
With Selection.PageSetup
.Orientation = wdOrientLandscape
.PageWidth = CentimetersToPoints(42)
.PageHeight = CentimetersToPoints(29.7)
End With
Selection.Sections(1).Headers(wdHeaderFooterPrimary).Range.Delete
This code will insert a new section+page break, set this new section to landscape A3, and remove the headers from it.
Note: You might need to unlink the headers before deleting it:
selection.Sections(1).Headers(wdHeaderFooterPrimary).LinkToPrevious=False
Hope this helps.
Here is the working code in case someone else also find it useful:
'Add drawing
If wordDrawingExist Then
Set wb = Documents.Open(wFile)
Selection.WholeStory
Selection.Copy
Documents(docLogSkjema).Activate
Selection.EndKey Unit:=wdStory
Selection.InsertBreak Type:=wdSectionBreakNextPage
With Selection.PageSetup
.Orientation = wdOrientLandscape
.PageWidth = CentimetersToPoints(42)
.PageHeight = CentimetersToPoints(29.7)
End With
Selection.Sections(1).Headers(wdHeaderFooterPrimary).LinkToPrevious = False
Selection.Sections(1).Headers(wdHeaderFooterPrimary).Range.Delete
Selection.Sections(1).Footers(wdHeaderFooterPrimary).LinkToPrevious = False
Selection.Sections(1).Footers(wdHeaderFooterPrimary).Range.Delete
Selection.Paste
wb.Close False
End If
I have lots of copy-paste to do in Microsoft Word and after pasting, I need to put the pasted text with a different color than black.
Sub PasteUnformattedText()
Selection.EndKey Unit:=wdLine
Selection.Font.Color = 12611584
Selection.PasteSpecial DataType:=wdPasteText
End Sub
What do I need to do to change the color of the pasted text? I've tried with "Selection.Font.Color = 12611584 ", but the color still remains the default one: the black.
Solution: Just add
Dim MyText As String
MyText = " "
Selection.TypeText (MyText)
before
Selection.PasteSpecial DataType:=wdPasteText
I am pulling text from another application and creating a MS-Word document on the fly.
Occasionally there may be some highlighting of words needed which I perform as I find these. What I cannot understand is how to cease displaying the HighlightColorIndex.
I've tried Selection.Collapse, Selection.Range.Collapse and Selection.Range.HighlightColorIndex = wdNoHighlight all to limited success. Can you assist please?
Dim lngRangeStart As Long
Dim lngRangeEnd As Long
Selection.TypeText Text:="Test of colour" ' No highlighting at present
Selection.TypeParagraph '
Selection.TypeText Text:="Starting colour after colon: " ' No highlighting at present
lngRangeStart = Selection.Start ' set to the start of the Range
Selection.Range.StartOf
Selection.TypeText Text:="This text is highlighted"
lngRangeEnd = Selection.Start ' set to the end of the Range and sel.start appears correct
Selection.SetRange Start:=lngRangeStart, End:=lngRangeEnd ' sets range correctly
Selection.Range.HighlightColorIndex = wdYellow
' >>> This is where I need to cease highlighting but what to do?
{funky code to stop highlighting here}
Selection.TypeText Text:="Now back to clear text"
You need to select text as you did before and reset its highlight to none wdNoHighlight
Use below code
' >>> This is where I need to cease highlighting but what to do?
'{funky code to stop highlighting here}
Selection.Move WdUnits.wdCharacter, 1
''Clear for text
lngRangeStart = Selection.Start
Selection.TypeText text:="Now back to clear text"
lngRangeEnd = Selection.Start
Selection.SetRange Start:=lngRangeStart, End:=lngRangeEnd ' sets range correctly
Selection.Range.HighlightColorIndex = wdNoHighlight
Selection.Move WdUnits.wdCharacter, 1
Selection.TypeText text:="Now back to the future text"
If I understand your question correctly, then you just set the highlight color to wdColorAutomatic, which is a constant specifying the automatic (default) color.
So putting it all together, to highlight text, you'd set its background to wdColorYellow. To remove the highlighting, you'd set its background to wdColorAutomatic.
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 4 years ago.
Improve this question
For some automated tests I need to create a Word Doc that contains all the glyphs of a font (for several different fonts). Is there an easy way to create a macro that loops through all the available glyphs in a font (and inserts them into a doc)?
Is there a particular reason why it needs to be in Word? Is this simply to visualize all the characters of a font? If so, you can use Font Book in OS X and go to Print, select Report Type: Repetoire, and save out to PDF.
Edit: Seems I missed "automated tests". Disregard.
Geez... I've made something like that a long time ago... Yes, it's possible to do it.
A good start is the MSDN
Edited to add:
I knew I had done something like this before. Going through some of my old emails I found a macro I've sent to a friend of mine containing exactly this. Here it is:
Sub GenerateFontCatalog()
'
' Macro created in 05/14/2008 by Paulo Santos
'
Dim i As Long
Dim j As Long
Dim fnt As String
Dim doc As Document
Dim fnts() As String
'*
'* Get all font names
'*
Word.StatusBar = "Reading Font Names..."
ReDim fnts(Word.FontNames.Count)
For i = 1 To Word.FontNames.Count
fnts(i) = Word.FontNames.Item(i)
DoEvents
Next
'*
'* Sort alphabetically
'*
Word.StatusBar = "Sorting Font Names..."
For i = 1 To UBound(fnts)
For j = i + 1 To UBound(fnts)
If (fnts(i) > fnts(j)) Then
fnt = fnts(i)
fnts(i) = fnts(j)
fnts(j) = fnt
End If
Next
DoEvents
Next
Word.StatusBar = "Generating Font Catalog..."
Set doc = Application.Documents.Add()
doc.Activate
'*
'* Page configuration
'*
With ActiveDocument.PageSetup
.Orientation = wdOrientPortrait
.TopMargin = CentimetersToPoints(2)
.BottomMargin = CentimetersToPoints(2)
.LeftMargin = CentimetersToPoints(2)
.RightMargin = CentimetersToPoints(2)
End With
For i = 1 To UBound(fnts)
'*
'* Write font name
'*
Selection.Font.Name = "Arial"
Selection.Font.Size = 10
If (i > 1) Then
Selection.TypeParagraph
Selection.ParagraphFormat.KeepTogether = False
Selection.ParagraphFormat.KeepWithNext = False
Selection.TypeParagraph
End If
Selection.TypeText fnts(i)
Selection.ParagraphFormat.KeepWithNext = True
Selection.TypeParagraph
'*
'* Write font sample
'*
Selection.Font.Name = fnts(i)
Selection.Font.Size = 16
Selection.TypeText "ABCDEFGHIJKLMNOPQRSTUVWXYZ" & Chr(11)
Selection.TypeText "abcdefghijklmnopqrstuvwxyz" & Chr(11)
Selection.TypeText "0123456789"
Selection.ParagraphFormat.KeepTogether = True
DoEvents
Next
'*
'* Adjust cursor position
'*
Selection.HomeKey Unit:=wdStory
Selection.InsertBreak Type:=wdSectionBreakNextPage
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=1
Word.StatusBar = "Generating Font Index..."
For i = 1 To UBound(fnts)
Selection.Font.Name = "Arial"
Selection.Font.Size = 10
Selection.TypeText fnts(i) & vbTab
Selection.Font.Name = fnts(i)
Selection.TypeText "ABC abc 123"
Selection.TypeParagraph
Next
'*
'* Split the document in two columns
'*
With Selection.Sections(1).PageSetup.TextColumns
.SetCount NumColumns:=2
.EvenlySpaced = True
.LineBetween = False
End With
Selection.HomeKey Unit:=wdStory, Extend:=True
Selection.ParagraphFormat.TabStops.Add Position:=Selection.Sections(1).PageSetup.TextColumns(1).Width, Alignment:=wdAlignTabRight, Leader:=wdTabLeaderSpaces
Selection.HomeKey Unit:=wdStory
Word.StatusBar = ""
End Sub
Programs like MS Word won't be able to tell you what characters are available in a font. As far as I can tell you from experience, only the Window's "Character Map" application can show you. Character Map can be found in your Start menu via Accessories, or alternatively by Start, Run..., and typing "charmap" but there's no convenient method to collect these characters from Character Map or MS Word.
Strictly in Word, I have no idea if it's possible, but since you can execute scripts in Word, I'm sure it's possible to read the font files and read their binary data to collect the available characters inside it.. that's the long-winded way, and possibly the only way to get what you desire.
I've not been able to find a suitable program online to do this for me either, sorry.
It will be nice idea to insert
The quick brown fox jumps over the
lazy dog
and loop through the fonts that need to be tested using a macro.
Seems like a pretty good compromise is to create an html file with &#XXX; entries for each character and then open that with MS Word.