How to choose a different header image in MS Word 2013 using a macro/button - vba

I'd like to create a Word stationary template with ability to cycle through different colored logos in its header. My company uses a logo in five different colors and I would like to create a single template with a button that would allow me to cycle through the different colored logos every time I create a new document from this template. Can this be done, perhaps with a little VBA?
Edit:
After working with an answer from Olle Sjögren I've come up with the following working script:
Option Explicit
Public imgCounter As Integer
Sub cycle_logos()
Dim I As Variant
Dim logoColors(4) As String
logoColors(0) = "logo_magenta.png"
logoColors(1) = "logo_teal.png"
logoColors(2) = "logo_orange.png"
logoColors(3) = "logo_red.png"
logoColors(4) = "logo_grayscale.png"
For Each I In logoColors
ActiveDocument.StoryRanges(wdPrimaryHeaderStory).ShapeRange.Item(I).Visible = msoFalse
Next I
imgCounter = imgCounter + 1
If imgCounter = 5 Then imgCounter = 0
ActiveDocument.StoryRanges(wdPrimaryHeaderStory).ShapeRange.Item(logoColors(imgCounter)).Visible = msoTrue
End Sub
It is worth mentioning how I came up with the image names, since I didn't find a way to do this from inside Word. I renamed the template extension to zip and unzipped it. In the extracted files I opened word\header2.xml (this may vary, depending on the position in the document) and edited the nodes containing the names of pictures, i.e. <wp:docPr/>, e.g.:
<wp:docPr name="Picture 1" id="1"/>
became:
<wp:docPr name="logo_magenta.png" id="1"/>
etc. I then replaced the XML file in the ZIP with my edited version and changed the extension back to dotm.

As mentioned, there are several ways to do this. I would suggest storing the images outside of the template, otherwise all documents based on the templates would include all logo images, even if they are not shown, making the documents bigger than they need to be. That approach makes installing the template a bit harder, since you would have to copy the images to the clients as well as the template file.
To answer your question regarding addressing the images in the header - you can address then through the correct story range object. In my example I assume that they are in the primary header. To tell the different images apart, you can use the Name property or the index in the Item collection:
ThisDocument.StoryRanges(wdPrimaryHeaderStory).ShapeRange.Item("Picture 1").Visible = msoTrue
ThisDocument.StoryRanges(wdPrimaryHeaderStory).ShapeRange.Item(1).Visible = msoFalse

Related

I'm trying to create a header that begins on the second page, inserts an em dash, the page number and another em dash, centered in vba

document.Application.ActiveDocument.Sections(1).Headers(WdHeaderFooterIndex.wdHeaderFooterPrimary) _
.PageNumbers.StartingNumber = 2
For Each section As Word.Section In document.Application.ActiveDocument.Sections
Dim headerRange As Word.Range = section.Headers(Word.WdHeaderFooterIndex.wdHeaderFooterPrimary).Range
headerRange.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter
headerRange.Text = " — "
headerRange.Fields.Add(headerRange, Word.WdFieldType.wdFieldPage)
headerRange.Text = headerRange.Text & " — "
Next
The issue that I am having is I cannot get the dashes on either side of the page number. It will always place both of them before or after the page number.
I have tried concatenating, I have tried various placements of the dashes. I have tried the headerRange.Collapse with no success.
'document.Application.ActiveDocument.Sections(1).Headers(WdHeaderFooterIndex.wdHeaderFooterPrimary) _
' .PageNumbers.StartingNumber = 2
'For Each section As Word.Section In document.Application.ActiveDocument.Sections
' Dim headerRange As Word.Range = section.Headers(Word.WdHeaderFooterIndex.wdHeaderFooterPrimary).Range
' headerRange.Text = "—"
' headerRange.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter
' headerRange.Collapse(Word.WdCollapseDirection.wdCollapseEnd)
' headerRange.Fields.Add(headerRange, Word.WdFieldType.wdFieldPage)
' headerRange.Collapse(Word.WdCollapseDirection.wdCollapseEnd)
' headerRange.Text = "-"
'Next
To a man with a hammer, everything looks like a nail.
You are doing this the hard way, in my opinion.
I look at using a macro for this as reinventing the wheel - Instead, use Templates or Building Blocks
Perhaps I am lazy, but setting things up in vba and formatting it is hard, at least to me.
You could create a template with your header and use that as the basis for new documents. Here is my page on Templates in Microsoft Word.
You could save this as a Building Block if you want to use it in existing documents. Remember that using a page number building Block for top of page replaces any existing header, for bottom of page replaces any existing footer.
Here is a temporary link to a template containing three page number building blocks with those for top and bottom of the page being centered. All have M-dashes on either side. The font and size will be determined by the Header or Footer styles in the document. The template contains instructions for using it.
If you want to use vba to insert these building blocks, there are examples shown on my web page with specific instructions on placement of the macros and building blocks. Here is my answer here about using vba to insert a Table of Contents a Building Block.
You could also have a macro to create a new document based on your template.
No matter how you decide to do this, keep in mind that each Word section has three headers, whether or not they are seen. In multi-section documents, these may, or may not, be linked to like headers in previous sections.
Here is my recap of Header and Footer Settings.

Save InlineShape picture to file in Word VBA using WordXML

Reviewing this question Save InlineShape picture to file in Word VBA, the accepted answer works fine for our case but the saved png doesn't have the size used in the document and simply has the full original size.
As in the original question, the alternative that uses ADODB generates some artifacts in the file (white spaces) that I couldn't fix in code (don't know what causes them).
The HTML or the zip ways don't work for me because I have to keep track of each picture's name and location in the document (not that is important for this question but is a constrain of the process, I save those names in a CSV that also relates to the table in which appears the picture).
The way I used to do it was to copy the inlineshape range as a picture and save the clipboard content to a file with a powershell command run from within the vba code, but the antivirus where flagging the code and didn't let it to go through (I can't touch the antivirus, as is a macro for the client to execute)
I have searched but can't find a way to save in a folder the picture (inline shapes) with the size used in the document.
The saved picture could be in png, jpg or bmp.
Edit: I believe that the trick is in how the range is created from the Inline Shape's Range
Dim r As Range
Set r = shp.Range.Duplicate
r.Start = r.Start - 1
r.End = r.End + 1
I don't know if it is possible that when the creation of the duplicated range it could respect the configuration of the original object

VBA code not exiting list (MS Word)

Writing a macro to automatically fix paraphrase spacing issues in MS Word docs generated from software we use.
Goal:
All standard paragraphs have 0pt before and after spacing.
All bullet lists have 3pt before and after spacing.
Progress:
Currently I have a function that sets the entire document to 0pt, then looks through for all lists and changes them to 3pt. (currently also have a highlight on so I can easily see what is being treated as a list).
It works great on some parts, but on other parts (I assume based on how the software we use generates the document), the list doesn't exist and it will continue to format blocks of text and heading to 3pt when it is not wanted (see attached images).
Current code is:
Sub Paragraph()
ActiveDocument.Range.ParagraphFormat.SpaceAfter = 0
ActiveDocument.Range.ParagraphFormat.SpaceBefore = 0
Dim li As Word.list
For Each li In ActiveDocument.lists
li.Range.ParagraphFormat.SpaceBefore = 3
li.Range.ParagraphFormat.SpaceAfter = 3
li.Range.HighlightColorIndex = wdYellow
Next li
End Sub
Working:
Not working:
According to the MSDN:
List Object: Represents a single list format that's been applied to specified paragraphs in a document.
So if you have more than one list with some non-bulleted paragraph(s) in the middle, the Range will start with the first item of the first list and end with the last item of the last list including all non-bulleted paragraph(s) in the middle.
To fix this issue, you need to separate the lists (right-click on the bullet and select Separate List). However, you mentioned that the document was generated by some software, so that is probably not an option. In that case, you will have to iterate though the paragraphs of the Range of each List and check if it has a ListFormat.ListTemplate which indicates that it is a list item, otherwise it is a non-bulleted paragraph:
Sub Paragraph()
ActiveDocument.Range.ParagraphFormat.SpaceAfter = 0
ActiveDocument.Range.ParagraphFormat.SpaceBefore = 0
Dim li As Word.List
Dim p As Paragraph
For Each li In ActiveDocument.Lists
For Each p In li.Range.Paragraphs
If Not p.Range.ListFormat.ListTemplate Is Nothing Then
p.Range.ParagraphFormat.SpaceBefore = 3
p.Range.ParagraphFormat.SpaceAfter = 3
p.Range.HighlightColorIndex = wdYellow
End If
Next p
Next li
End Sub
Even before touching VBA:
Use Styles in the document.
Limit the use of Styles in the document to only those that are in the
template.
Set your spacing in the Styles.
If, at some stage, you change your mind and want to use 6pt spacing, you can adjust the template and re-apply it, rather than finding all the VBA code and re-writing it. Not only that, but by using Styles, you can avoid having VBA code, or having VBA-enabled documents which may interfere with some corporate security settings.
Oh, and set up your corporate structure to limit the use of templates to only the approved ones.

Cloning a form field with all styles using PDFBox

We need to fill out a form for our customers and get a PDF, which they can print, sign & send back. As the PDF has to change frequently, we use PDF templates with form fields, which are fill by our tool (pdftk). For various reasons I would like to switch to PDFBox (one is, that it required us to split the templates in individual pages and save them to disk, fill them and then merged them together again). So far everything works fine.
But I struggle with the page numbering. As the form is combined out of multiple templates, I have to fix the page number with PDFBox. So far, we used a styled input field page_num on every page. But since they all have the same name, I can't fill them individually.
Can I somehow split or clone the fields and give them individual names, so I can fill them individually? Of course, the styling should stay like it is.
With the help of the PDFBox guys I've got it to work. My solution is using JRuby, but I think you could pretty easily translate it to Java (remove the Java::OrgApachePdfbox... namespace).
doc = Java::OrgApachePdfboxPdmodel::PDDocument.load("input.pdf")
form = doc.getDocumentCatalog.getAcroForm
pages = doc.getDocumentCatalog.getAllPages.toArray.to_a
page_num = form.getField("page_num")
string = page_num.getDictionary
.getDictionaryObject(Java::OrgApachePdfboxCos::COSName::DA)
page_num.getKids.to_array.each do |widget|
widget_dict = widget.getDictionary
widget_dict.setString(Java::OrgApachePdfboxCos::COSName::DA, string.getString)
field = Java::OrgApachePdfboxPdmodelInteractiveForm::PDTextbox.new(
form,
widget_dict
)
field.setParent(page_num)
page = (pages.index(widget.getPage) + 1).to_s
field.setPartialName("page_num_#{page}")
field.setValue(page)
end
doc.save("output.pdf")

How to make a whole worksheet use solid fill in the data bars in excel

I'm having a problem with my excel 2010 (and 2013 also) that I have a page
worksheet with data bars, and I have set them to solid fill, but every time
I close and open the document, it has changed to gradient again, quite annoying (since you can't really see the progress when it is fading into white, which is the same as the background...)
Checked the Office Homepage, but couldn't find this issue anywhere mentioned.
Also tried to Google it, just found a few who had similar problem, but no solution.
For the purpose of presentation I could change the background etc. But what is the fun in that, I would like to try to make sure it is solid fill every time I open this file. And it looks nice when it is solid fill.
I see 2 ways this could be achieved:
Would be if one could change the default settings (since I guess that is what happens every time I re-open the file). Tried to Google it but couldn't find it.
Another way would be to have a VBA script that says "hey, all you data bars in this range, you should have solid bars".
I tried option 2 on my own, but since I'm quite new to scripting in VBA, I didn't succeed, but it looked like this my try:
Private Sub Workbook_Open()
dad = Range("A1:Z100")
Dim b As Databar
b = dad.FormatCondition.AddDatabar
b.BarFillType = xlDataBarFillSolid
End Sub
But that didn't work, I guess one should create the bars and then use this options on those bars, but I already have a document with maybe 200 bars, which looks perfectly fine, except for them loosing the solid option.
And since they depend on different numbers (the data bars), I can't have one "rule to rule them all" (conditioning formatting).
Update: 2015-05-22
Managed to create new Databars to my liking, by this code below
Sub TestDatabars()
' column B real values
Dim B1rv As Databar
Range("B6:B10, B14:B37,B42:B43").Select
' remove old settings (gradient fill)
With Selection
.FormatConditions(1).Delete
End With
' add a new one
Set B1rv = Selection.FormatConditions.AddDatabar
With B1rv
.BarFillType = xlDataBarFillSolid
End With
With B1rv.BarColor
.Color = RGB(146, 208, 80)
End With
B1rv.MinPoint.Modify newtype:=xlConditionValueNumber, newvalue:=0
B1rv.MaxPoint.Modify newtype:=xlConditionValueNumber, newvalue:=Range("B1")
end sub
But I guess the question remains if I need to change all my old databars (around 100 databars) or if there is a more common way.
Will test some thing with making a range selection and see if I get edit those allready there.
Try this:
Set b = dad.FormatCondition.AddDatabar
Notice the keyword Set - you need to use that when assigning an object.