Adding Page number and new line after a border line in MS Word header by a VBA excel program - vba

I have a little problem with my vba program.
I have a program in VBA excel to create a new word document. I would like to add a Header in my word document, but I am new to VBA in word. So I don't know how to do it.
In my header, I would like to have some information from Excel on the left side and the page number " Page X of Y" on the right side. One more thing, I was able to add a border line under my header, but I don't know how to add a extra line after the border to keep a space between header and normal text.
Here is my code:
Dim objword As Word.Application
Dim mydoc As Word.document
Dim WRng As Word.Range
Set objword = CreateObject("Word.application")
Set mydoc = objword.Documents.Add
'HEADER
Set WRng = mydoc.Sections(1).Headers(wdHeaderFooterPrimary).Range
WRng.Text = wsexcel.Range("A5") & " " & wsexcel.Range("B5") & vbtab & **Page number of total**
WRng.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
**???? Add space after the border line???**
Header example
code

Either of the following will create a space after the bottom border line in your header:
1) Increase the size of the top margin in the page layout/formatting. (This is the distance between the top edge of the paper and the first line of non-header text on the page.)
2) In the paragraph formatting of the header text, increase the "spacing after" setting. Set the option for eliminating spacing between paragraphs of the same style or you might end up creating space between all the lines of your heading text.
You can do either of these in your VBA code.

Related

How to change font size and formatting for dropdown lists created in VBA

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

Convert Figure Alt Description to Picture Caption in Word

I need a way to get an image's Alt Description (specified in HTML) into the Word DOCX image's Caption. This needs to be done with many images in a document, so a macro would be best.
Assume an HTML doc with an img tag similar to this
<img src="http://www.example.com/path/to/image/picture01.jpg"
title="picture 01 title"
alt="this is alt text"
caption="this is a caption field">
This HTML doc is imported into Word 2010 (via File, Open). The image will show in the doc.
Now, how to get the 'title' attribute (which shows up in the Format Picture's Alt-Text dialog as the Description - see screenshot below) into the image's Caption?
Note that the caption parameter in the image tag is not converted to a Word Caption for that image.
Sample Alt-Text dialog for an image which shows the image's alt value as the Description
Microsoft Word has a Range.InsertCaption method, which will insert field codes to automatically number images. As you were asking to insert Alternative Text, my feeling is you were using the term caption simply as a directive to get the text beneath each image on its own carriage return. So that's what this code does:
Sub GenerateAltTextCaptions()
Dim AltTextCaption As String
Dim ImageRange As Range
Selection.GoTo What:=wdGoToSection, Which:=wdGoToFirst
With ActiveDocument
For i = 1 To .InlineShapes.Count
AltTextCaption = .InlineShapes(i).AlternativeText
Set ImageRange = .InlineShapes(i).Range
ImageRange.Collapse Direction:=wdCollapseEnd
ImageRange.InsertAfter vbCr
ImageRange.InsertAfter AltTextCaption
Next
End With
End Sub
Yes, I think you've hit on a good way to make the conversion. Glad you were able to find it!
The code below will loop all the InlineShapes in the document and, if the Alternative Text is not empty, create a caption using that text.
InsertCaption is only available in VBA for InlineShapes. The user can insert captions for Shapes (graphics with text wrap formatting) because Word evaluates the selected graphic and creates a Textbox of the same width and positions it immediately below the graphic. The Shape and textbox are not, however, linked together in any way. So this functionality is not offered in VBA and would require some "creative" programming.
Sub InsertCaptionFromAltText()
Dim doc as Word.Document
Dim ils As word.InlineShape
Dim captionText As String
Set doc = ActiveDocument
Set ils = doc.InlineShapes(1)
For each ils in doc.InlineShapes
captionText = ils.AlternativeText
If Len(captionText) > 0 Then
ils.Range.InsertCaption Label:=wdCaptionFigure, _
Title:=captionText, _
Position:=wdCaptionPositionBelow
End If
Next
End Sub

Write and Style In Loop

Say that I have the following code to write headings from an array to a word document and to apply defined styles:
With wdDoc
Set wrdRange = .Range(0, 0) ' Set initial Range.
i = 2
Do Until i > 6
' Debug.Print wrdRange.Start, wrdRange.End
wrdRange.text = totalArray(i, colIndex(3)) & Chr(11)
Set wrdRange = .Paragraphs(i - 1).Range
wrdRange.Style = totalArray(i, colIndex(2))
wrdRange.Collapse 0
i = i + 1
Loop
End With
One would expect the following to occur:
The word range moves programmatically as I move through the document.
The word style is updated for the new range (defined by the set statement)
The Range collapses to the end (0 = wdCollapseEnd) and the loop continues until the initial conditions are satisfied.
What I can't seem to fix is the styles being applied to ALL existing paragraphs in the document. The Debug.Print statement should show the range being updated as expected, despite the fact that the style applies to all existing paragraphs.
As you can tell, I've toyed around with this quite a bit, to no avail. Any help would be appreciated in this matter.
Thanks.
In the following line of code:
wrdRange.text = totalArray(i, colIndex(3)) & Chr(11)
Use Chr(13) instead of Chr(11). The latter is simply a line break, not a new paragraph. So applying a style to any part of the Range is actually applying it to all the text your code is generating because it's a single paragraph.

Word VBA match paragraph indent to heading text

How can I align a paragraph with just the text portion of a numbered heading? e.g:
1.1.2 This Is A Numbered Heading
This is the aligned text I'm trying to achieve
This is aligned to the numbers not the text
2.4 This Is Another Example
This is where the text should be
I'm aware of the CharacterUnitLeftIndent, CharacterUnitFirstLineIndent, FirstLineIndent etc properties but after a few hours experimentation & searching online can't figure out how to achieve this programmatically. I know how to test for the heading style and how to refer to the following paragraph so just need to know how to get the indent right.
To use a macro to accomplish this, you have to check each paragraph in your document and check to see if it is a "Header" style. If so, then pick off the value of the first tab stop to set as the indent for the subsequent paragraphs.
UPDATE1: the earlier version of the code below set the paragraphs to the Document level first tab stop, and did not accurately grab the tabstop set for the Heading styles. The code update below accurately determines each Heading indent tab stop.
UPDATE2: the sample text original I used in shown in this first document:
The code that automatically performs a first line indent to the tab level of the preceding heading is the original Sub from the first example:
Option Explicit
Sub SetParaIndents1()
Dim myDoc As Document
Set myDoc = ActiveDocument
Dim para As Paragraph
Dim firstIndent As Double 'value in "points"
For Each para In myDoc.Paragraphs
If para.Style Like "Heading*" Then
firstIndent = myDoc.Styles(para.Style).ParagraphFormat.LeftIndent
Debug.Print para.Style & " first tab stop at " & _
firstIndent & " points"
Else
Debug.Print "paragraph first line indent set from " & _
para.FirstLineIndent & " to " & _
firstIndent
para.FirstLineIndent = firstIndent
End If
Next para
'--- needed to show the changes just made
Application.ScreenRefresh
End Sub
And the results looks like this (red lines added manually to show alignment):
If you want the entire paragraph indented in alignment with the heading style, the code is modified to this:
Option Explicit
Sub SetParaIndents2()
Dim myDoc As Document
Set myDoc = ActiveDocument
Dim para As Paragraph
For Each para In myDoc.Paragraphs
If para.Style Like "Heading*" Then
'--- do nothing
Else
para.Indent
End If
Next para
'--- needed to show the changes just made
Application.ScreenRefresh
End Sub
And the resulting text looks like this:

VBA: Replace text based on formatting

I have a table in a Word file A which contains a bunch of different Contents. Which I just copy using VBA into another Word or PowerPoint file B. So far that is not a problem.
However, since file A is a working sheet, people sometimes cross stuff out, which means: it should be removed, but for the record it stays in there first. In the final version it shouldnt be displayed, so in the process of copying everything in a different file, the crossed out text should be removed.
To break it down to the technical stuff:
I want to select text in a Word document, and then remove all text that has a certain formatting.
Maybe there is a special selection possibility or a way to iterate through all characters and test for formatting.
The best way to do this without suffering severe performance iterating characters or paragraphs in vba is to use find and replace.
You can do this in vba as follows, note I have wrapped all the actions in a custom undo record, then you can call your current vba routine with CopyDocumentToPowerPoint and the word document will be restored to the state it was before the macro ran (crossed out text remains in word, but is not pasted to powerpoint).
'wrap everything you do in an undo record
Application.UndoRecord.StartCustomRecord "Move to powerpoint"
With ActiveDocument.Range.Find
.ClearFormatting
.Font.StrikeThrough = True
.Text = ""
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With
'copy to powerpoint and whatever else you want
CopyDocumentToPowerPoint
Application.UndoRecord.EndCustomRecord
'and put the document back to where you started
ActiveDocument.Undo
It is possible to go character-by-character and remove those which have the strikethrough font enabled on them (the ones which are crossed out) in MS Word. However, as far as I know, there is no such possibility to detect a strike-through font in MS PowerPoint.
If you just need to delete the text which has the strikethrough font on it in the selected text only, you can use this Word macro:
Sub RemoveStrikethroughFromSelection()
Dim char As Range
For Each char In Selection.Characters
If char.Font.StrikeThrough = -1 Then
char.Delete
End If
Next
End Sub
If more integrated to copying a Word table to another Word document and PowerPoint presentation, the following code might be useful. It first pastes the table to a new Word file, then removes unnecessary characters, and after that pastes this new table to PowerPoint.
Sub CopyWithoutCrossedOutText()
Dim DocApp As Object: Set DocApp = CreateObject("Word.Application")
Dim PptApp As Object: Set PptApp = CreateObject("PowerPoint.Application")
Dim Doc As Object: Set Doc = DocApp.Documents.Add
Dim Ppt As Object: Set Ppt = PptApp.Presentations.Add
Dim c As Cell
Dim char As Range
DocApp.Visible = True
PptApp.Visible = True
'Copying Word table to the 2nd Word document
ThisDocument.Tables(1).Range.Copy
Doc.ActiveWindow.Selection.Paste
'In the 2nd Word document - removing characters having strikethrough font enabled on them
For Each c In Doc.Tables(Doc.Tables.Count).Range.Cells
For Each char In c.Range.Characters
If char.Font.StrikeThrough = -1 Then
char.Delete
End If
Next
Next
'Copying the table from the 2nd Word document to the PowerPoint presentation
Doc.Tables(1).Range.Copy
Ppt.Slides.Add(1, 32).Shapes.Paste
End Sub