Microsoft provided a Custom UI editor to edit Ribbon and create your own. You can also add symbols to that particular button added through UI editor. These symbols are integrate which means that they are in that file. As seen in image:
I am stuck in a situation where I need to Insert that particular custom UI icons into MS word document using a macro.
Set newDoc = ActiveDocument
Set mytable = _
newDoc.Tables.Add(Range:=Selection.Range, NumRows:=1, _
NumColumns:=2)
mytable.Rows.Height = 50
mytable.Cell(1, 1).SetWidth ColumnWidth:=InchesToPoints(1.3), RulerStyle:=wdAdjustNone
mytable.Cell(1, 2).SetWidth ColumnWidth:=InchesToPoints(5.3), RulerStyle:=wdAdjustNone
mytable.Shading.BackgroundPatternColor = -603917569
mytable.Cell(1, 2).Range.InsertAfter "<Enter information content here>"
mytable.Cell(1, 1).Range.Select
Selection.InlineShapes.AddPicture fileName:= _
ActiveDocument.path & "\Bulb.png", LinkToFile:=False, _
SaveWithDocument:=True 'Here I need something which will insert integrated bulb icon
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
mytable.Cell(1, 2).Range.Select
Selection.Font.Color = wdColorGray35
Selection.Font.Italic = wdToggle
Selection.Font.ItalicBi = wdToggle
Selection.Font.Size = 11
Is there a way to insert that particular icon into MS word document? so that it can work on any other computers without providing icon file.
My final result should be look like this:
Related
I am new to VBA in Word with some experience in Excel. I am trying to produce a Word document from an Excel file. The first task is to set up the headers and footers, which I am struggling with. For context, I have added the reference to Word in Excel and will likely convert to late-binding at a later date because this is a tool I will distribute to peers. The goal of this macro is to generate a document with data that matches a report format, so the formatting is not my choice; I have to match it as the Word template is set up. At this point I am not using late binding so that I can use Intellisense while I learn this.
Requirements for the footer:
Centered text, Arial, size 8: "Page " and then an automatically generated page number.
Right-aligned text, Arial, size 8, bold: "Other Support Page"
A top line border for the entire footer.
What I want:
I can get most of this to function except it's either entirely bold or entirely not bold. I have looked into using "Collapse 0", however, it screws up the top border. Also, I have tried to use style objects to lower the amount of code, but it then wipes out the default tab stops. I am struggling to add the tab stops back into the footer (center 3.25" and right 6.5"). I have no problem adding tab stops in the body, but for some reason the code executes but does nothing with the tab stops when I try and put them in the footer. First try here has it set up correctly, but bolds the entire thing:
With rngFooter
.Font.Name = "Arial"
.Font.Size = "8"
.Fields.Add rngFooter, wdFieldPage, , False
.InsertBefore vbTab & "Page "
.Font.Bold = True
.InsertAfter vbTab & "Other Support Page"
With rngFooter.Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth075pt
.Color = Options.DefaultBorderColor
End With
End With
I have read about moving styles until after the text you want to format. So if I were to use the styles I have created, the tab stops get wiped out and the formatting isn't right anyways (the "b" in the style name means it is set to bold):
With rngFooter
.Fields.Add rngFooter, wdFieldPage, , False
.InsertBefore vbTab & "Page "
.Style = A8
.InsertAfter vbTab & "Other Support Page"
.Style = AB8
With rngFooter.Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth075pt
.Color = Options.DefaultBorderColor
End With
End With
If I add the collapse in, it screws up the borders.
With rngFooter
.Fields.Add rngFooter, wdFieldPage, , False
.InsertBefore vbTab & "Page "
.Style = A8
.Collapse 0
.InsertAfter vbTab & "Other Support Page"
.Style = AB8
With rngFooter.Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth075pt
.Color = Options.DefaultBorderColor
End With
End With
I really want to understand how to do this properly because I will also be trying to change styles mid-way through table cells. I find the documentation on how ranges work to be confusing, but I do understand that the point of the collapse is to prevent it from overwriting the entire footer, which is what I was doing before. I just can't see how I can do the collapse and then also apply the top-line border to the whole footer. I have to put it in at the end also or it interferes with the page number.
Thank you Timothy Rylatt for the pointers to alignment tabs and character styling. I was able to avoid tables and generating a template file (which would be a lot more work as I need to distribute this Excel file to many users). My solution is as follows:
With rngFooter
.Style = A8
.InsertAlignmentTab 1, 0
.InsertAlignmentTab 2, 0
.Fields.Add rngFooter, wdFieldPage, , False
.InsertBefore vbTab & "Page "
.InsertAfter vbTab & "Other Support Page"
End With
' Make "Other Support Page" bold
With rngFooter.Find
.ClearFormatting
.Text = "Other Support Page"
.Replacement.ClearFormatting
.Replacement.Style = AB8
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceOne
End With
'Add border to entire footer
With rngFooter
.Expand Unit:=wdParagraph
With .Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth075pt
.Color = Options.DefaultBorderColor
End With
End With
Essentially I applied the base style (now a character style and not a paragraph style), then inserted the alignment tabs as the base tab stops from the Normal template were wiped out. I then add the page number, then the "Page " text, then the "Other Support Page" text. I do a find and replace on the specific expression to format, and apply a character style to ensure it doesn't expand the formatting to the full paragraph. The border issue is fixed by using .Expand on the range prior to applying the border. Order of operations was very important to making this work.
For me, the documentation on the Word object model is more confusing than Excel is, and I appreciate the specific topics to research. I also used this StackOverflow answer for the tip on using find and replace to change the styles, which worked once they were converted to Character Styles.
Do not use tabs for alignment because they are part of the paragraph and a paragraph can only have one style without some trickery.
By far the easiest way to get what you want is to follow this procedure which can be applied to either headers or footers
Insert a 1 row, 3 column table to get left, center and righgt 'fields'
Turn off the table borders
Insert the relevant text into each cell
Set the formatting of paragraph(1) of each cell
If required, turn on the bottom border of the Header Table and or the Top border of the Footer table.
If stuck for vertical space you might need to set the font hieght of the compulsory row after each table to 1 or 2 points.
Be aware that each section in the document has its own Headers and Footers and that there are three headers and three footers in each section.
I am trying to add the X of Y page numbers to the bottom right of a Word document. X being the current page number and Y being the total number of pages in the document.
I recorded a macro.
Sub InsertPageLabelsXofY()
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Application.Templates( _
"C:\Users\jhandler\AppData\Roaming\Microsoft\Document Building Blocks\1033\16\Built-In Building Blocks.dotx" _
).BuildingBlockEntries("Bold Numbers 3").Insert Where:=Selection.Range, _
RichText:=True
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub
This works initially, but after a day or so it gives me an error.
Run-time error '5941': The requested member of the collection does not exist
The line that generates the error is:
Application.Templates( _
"C:\Users\jhandler\AppData\Roaming\Microsoft\Document Building Blocks\1033\16\Built-In Building Blocks.dotx" _
).BuildingBlockEntries("Bold Numbers 3").Insert Where:=Selection.Range, _
RichText:=True
Also, I would like for other people to use the macro. Is there some way to save the template in a public area?
The built-in building blocks template is only loaded on demand, i.e. when a building-block it contains is inserted, as per the documentation. You can force it to load by adding the following line to your routine before you attempt to insert:
Application.Templates.LoadBuildingBlocks
However, if you take the advice offered by #CindyMeister (and you should) you will not need to do this as the template containing your code will already by loaded. You could then rewrite your routine as follows, avoiding the need to open and close the footer:
Sub InsertPageLabelsXofY()
Dim sectionNumber As Long
sectionNumber = Selection.Information(wdActiveEndSectionNumber)
Dim footer As Range
Set footer = ActiveDocument.Sections(sectionNumber).Footers(wdHeaderFooterPrimary).Range
Dim tmp As Template
Set tmp = ActiveDocument.AttachedTemplate
tmp.BuildingBlockEntries("Bold Numbers 3").Insert Where:=footer, RichText:=True
End Sub
To make your routine work, change the "Application.Templates ..." line to:
Templates(1).BuildingBlockEntries("Bold Numbers 3").Insert Selection.Range, True
Word's building blocks template is always available as a global template, and the Built-in version is always the first template, so it has an index of 1.
Trying to specify the path to this template is what is causing the error. Yes, it might work sometimes but at other times it doesn't, so it is best to just use the index level and it has the added benefit of allowing your code to be transportable to other systems. If you tried to execute your existing code on a system that does not have your Home directory, "handler" then it will fail.
Sub AddPageXofYtext()
Dim pageNumber, TotalPage As Long
TotalPage = Selection.Information(wdNumberOfPagesInDocument)
ActiveDocument.Styles("Header").ParagraphFormat.Alignment = wdAlignParagraphRight
Selection.Sections.Item(1).Headers(wdHeaderFooterPrimary).Range.Text = "Page " & Selection.Information(wdActiveEndAdjustedPageNumber) & " of " & TotalPage
pageNumber = 1
Do
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=pageN
Selection.InsertBreak Type:=wdSectionBreakContinuous
Selection.Sections.Item(1).Headers(wdHeaderFooterPrimary).LinkToPrevious = False
Selection.Sections.Item(1).Headers(wdHeaderFooterPrimary).Range.Text = "Page " & Selection.Information(wdActiveEndAdjustedPageNumber) & " of " & TotalPage
pageNumber = pageNumber + 1
If pageNumber = TotalPage Then Exit Do
Loop
End Sub
I am trying to center the first line of text on a document, which would usually be the title.
I am able to center the line with
Selection.Paragraphs.Alignment = wdAlignParagraphCenter
But I am not sure how it is selecting the file line, as I would also like to set the title to bold and caps.
Selection.Font.Bold = wdToggle
Selection.Font.AllCaps = True
_
Also is there a way to "detect" any text that is centered already and has an empty space(line) above and below it, or would that be too difficult to achieve?
Use a with statement to apply multiple formats. Here is an example:
With Selection
.Paragraphs.Alignment = wdAlignParagraphCenter
.Font.Bold = wdToggle
.Font.AllCaps = True
End With
I am making a VBA script to generate default pages for my template document, it is all going well except for when I try to insert an image that is right aligned and text wrapped. I used VBA many years ago only for excel so am not sure how to structure the VBA script. I started making the VBA script for the image by itself to be later integrated which you can find below.
What I want to achieve with the VBA script
For it to insert an image from a file within the same directory as the template file (do I have to put the full path or can I put a truncated one to specify that it will always be in the same directory?)
For the inserted image to be square text wrapped (default distances)
For the image to be aligned with the left margin relative to the line I have inserted it in
The height of the image is at 200 x 150
Would you kindly be able to help elaborate on the MWE I have below. Thank you:
Sub Insert_picture()
'
' Insert_picture Macro
'
Dim imagePath As String
imagePath = "C:\Users\Edoardo\Documents\My Work\PhD\SkyDrive\Tutoring\Houria\Image Replacement.jpg"
ActiveDocument.Shapes.AddPicture FileName:=imagePath, _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=-5, _
Top:=5, _
Anchor:=Selection.Range, _
Width:=200, _
Height:=150
With imagePath
.WrapFormat.Type = wdWrapSquare
End With
End Sub
I worked it out in the end as follows:
Sub Insert_SqWrap_Image()
Dim shp As Shape
Set shp = ActiveDocument.Shapes.AddPicture( _
FileName:="C:\Users\Edoardo\Documents\My Work\PhD\SkyDrive\Tutoring\Houria\Image Replacement.jpg", _
SaveWithDocument:=True, _
Anchor:=Selection.Range)
With shp
.WrapFormat.Type = wdWrapSquare
.Left = 246
.Top = 50
.Width = 250
.Height = 188
End With
End Sub
The problem I have got is that my corporate template set uses a SaveDate field in the footer of every word document - which is used to detail when the document was saved, which ties in with our custom document management system.
Subsequently, when users want to make a PDF of an old document, using the Save As PDF function of Office 2010, the Save Date is updated - creating a PDF of the old document, but with today's date. This is wrong. We are just trying to create a true PDF version of whatever the original document has in it.
To get around this, I am writing a macro solution which locks the fields, exports the document as a PDF and then unlocks the fields again.
I have come up against an issue where I can identify and lock all fields in the headers/footers (which is actually what I'm trying to do) but to make it more robust, need to find out a way to lock ALL FIELDS in ALL SECTIONS.
Showing you my code below, how can I identify all fields in all sections? Will this have to be done using the Index facility?
Sub CPE_CustomPDFExport()
'20-02-2013
'The function of this script is to export a PDF of the active document WITHOUT updating the fields.
'This is to create a PDF of the document as it appears - to get around Microsoft Word 2010's native behaviour.
'Route errors to the correct label
'On Error GoTo errHandler
'This sub does the following:
' -1- Locks all fields in the specified ranges of the document.
' -2- Exports the document as a PDF with various arguments.
' -3- Unlocks all fields in the specified ranges again.
' -4- Opens up the PDF file to show the user that the PDF has been generated.
'Lock document fields
Call CPE_LockFields
'Export as PDF and open afterwards
Call CPE_ExportAsPDF
'Unlock document fields
Call CPE_UnlockFields
'errHandler:
' MsgBox "Error" & Str(Err) & ": " &
End Sub
Sub CPE_LockFields()
'Update MS Word status bar
Application.StatusBar = "Saving document as PDF. Please wait..."
'Update MS Word status bar
Application.StatusBar = "Locking fields in all section of the active document..."
'Declare a variable we can use to iterate through sections of the active document
Dim docSec As section
'Loop through all document sections and lock fields in the specified ranges
For Each docSec In ActiveDocument.Sections
docSec.Footers(wdHeaderFooterFirstPage).Range.fields.Locked = True
docSec.Footers(wdHeaderFooterPrimary).Range.fields.Locked = True
docSec.Footers(wdHeaderFooterEvenPages).Range.fields.Locked = True
Next
End Sub
Sub CPE_UnlockFields()
'Update MS Word status bar
Application.StatusBar = "PDF saved to DocMan Temp. Now unlocking fields in active document. Please wait..."
'Declare a variable we can use to iterate through sections of the active document
Dim docSec As section
'Loop through all document sections and unlock fields in the specified ranges
For Each docSec In ActiveDocument.Sections
docSec.Footers(wdHeaderFooterFirstPage).Range.fields.Locked = False
docSec.Footers(wdHeaderFooterPrimary).Range.fields.Locked = False
docSec.Footers(wdHeaderFooterEvenPages).Range.fields.Locked = False
Next
End Sub
Sub CPE_ExportAsPDF()
'Update MS Word status bar
Application.StatusBar = "Saving document as PDF. Please wait..."
'Chop up the filename so that we can remove the file extension (identified by everything right of the first dot)
Dim adFilename As String
adFilename = Left(ActiveDocument.FullName, (InStrRev(ActiveDocument.FullName, ".", -1, vbTextCompare) - 1)) & ".pdf"
'Export to PDF with various arguments (here we specify file name, opening after export and exporting with bookmarks)
With ActiveDocument
.ExportAsFixedFormat outPutFileName:=adFilename, _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=True, _
OptimizeFor:=wdExportOptimizeForPrint, Range:=wdExportAllDocument, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateWordBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
End With
'Update MS Word status bar
Application.StatusBar = "PDF saved to DocMan Temp."
End Sub
Try something like the following to get to all fields in the document, header, footer, background and main text:
Sub LockAllFieldsInDocument(poDoc As Document, Optional pbLock As Boolean = True)
Dim oRange As Range
If Not poDoc Is Nothing Then
For Each oRange In poDoc.StoryRanges
oRange.Fields.Locked = pbLock
Next
End If
Set oRange = Nothing
End Sub
Here is another way to do it. It'll select the entire document and then lock all fields, before deselecting everything.
Sub SelectUnlink()
ActiveDocument.Range(0, 0).Select
Selection.WholeStory
Selection.Range.Fields.Unlink
Selection.End = Selection.Start
End Sub