Add a border to all images in Word document

To add a border to all images in a Word document, the record a macro feature will not work. Here is the code though that you can add your Microsoft Visual Basic for Applications.

Sub Borders()

' Adds a border of 0.25 width and colored 50% gray to every image in the document.

Dim pic As InlineShape

For Each pic In ActiveDocument.InlineShapes

    pic.Borders.OutsideLineStyle = wdLineStyleSingle

    pic.Borders.OutsideLineWidth = wdLineWidth025pt

    pic.Borders.OutsideColor = wdColorGray50

Next

End Sub

Macro for acronyms in Word 2013

I am by no means a macro expert. My macro skills are rudimentary, much to my own frustration. However, I recently spent some time to develop a macro to automatically create an acronyms list in Word 2013, which I've been wanting to do for a long time.

First the basic steps to get started.

1. As you come across a defined acronym in your document, highlight the definition and acronym. (In the tech writing world, we define acronyms the first time utilizing this format: "Common Configuration Enumerations (CCE)." For this macro, you'll highlight everything that's similar to the text in quotes.)
2. Click the References tab on the menu, and click Mark Entry in the Index group.
3. Leave the defaults in the form box and click Mark.
4. Once you've marked all the acronyms, place your cursor where you want the acronyms list.
5. Click the References tab, and click Insert Index.
6. On the form box, leave the defaults, but ensure the "Columns" option is set to "Auto."
7. Select the entire index Word just inserted.
8. Run the macro.

Need help adding a macro? Reference this site. 

Sub ChangeIndextoAcronymList()

' Converts selected field to static text

    Selection.Fields.Unlink

'Replaces blank Index Heading lines.

  Selection.Find.ClearFormatting
    Selection.Find.Style = ActiveDocument.Styles("Index Heading")
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindFalse
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    
    Selection.Find.Execute Replace:=wdReplaceAll
    
' Finds the left parenthesis and replaces it with a tab.

 Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "("
        .Replacement.Text = "^t"
        .Forward = True
        .Wrap = wdFindFalse
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Application.DisplayAlerts = False
    Selection.Find.Execute Replace:=wdReplaceAll
    

' Finds the right parenthesis and tab in the selection and replaces
' it with one tab.

  Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ")^t"
        .Replacement.Text = "^t"
        .Forward = True
        .Wrap = wdFindFalse
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

' Finds the right parenthesis and comma in the selection and replaces
' it with one tab.

  Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "),"
        .Replacement.Text = "^t"
        .Forward = True
        .Wrap = wdFindFalse
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll


'Converts the selected text to a table with unset number of rows.

    Selection.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=3, _
        AutoFitBehavior:=wdAutoFitFixed
        
' Insert a row at the top of the table
   Selection.Tables(1).Select
   Selection.InsertRowsAbove 1

' Add Text to cell 1,1 in table and type text
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:="Acronym"
    Selection.MoveRight Unit:=wdCell
    Selection.TypeText Text:="Definition"
    Selection.MoveRight Unit:=wdCell

'Apply Table_1 style to the table

    With Selection.Tables(1)
        .Style = "Table_1"
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = False
        .ApplyStyleLastColumn = False
    End With

'Delete third column of selected table

    Selection.Tables(1).Select
    With Selection
        .Columns(3).Delete
    End With

'Cut and paste second column

    Selection.Tables(1).Select
    
    With Selection
        .Columns(2).Select
        .Cut
        .PasteAndFormat (wdPasteDefault)
    End With

' Sort table by first column

    Selection.Tables(1).Select
    Selection.Sort ExcludeHeader:=True, FieldNumber:="Column 1", SortFieldType _
        :=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending

'Apply Table_Text style to the table and auto fits the table

    Selection.Style = ActiveDocument.Styles("Table_Text")
    Selection.Tables(1).AllowAutoFit = True
    Selection.Tables(1).AutoFitBehavior wdAutoFitContent
    Selection.Tables(1).Cell(1, 1).Range.Select
    Selection.Tables(1).AutoFitBehavior wdAutoFitWindow

Macro to Resize Selected Image in Word 2013

While searching macros, one thing I've noticed is that some people tend to make macros more complicated than necessary. In my experience, the cleaner the code, the more efficient it runs. Granted, I am by no means an expert in creating macros. I have a lot to learn; however, I'm learning.


I recently needed a macro to resize a selected image to 75 percent of its original size. Unfortunately, the "Record Macro" feature was not working as expected, so off I went to Mister Google.


After searching several sites, I came across a solution, but needed to modify it a touch to make it work efficiently.  Here is the end result:


Sub Image_75_Percent()
'
' Resize the selected image to 75 percent of its original size.
'
    Dim PecentSize As Integer
    PercentSize = 75
    Selection.InlineShapes(1).ScaleHeight = PercentSize
    Selection.InlineShapes(1).ScaleWidth = PercentSize
   
   
End Sub

Copy and paste this into a new macro named "Image_75_Percent." Then select an image and run the macro. Since you scaled the height and width 75 percent, the aspect ratio will be maintained.


Cheers!
Christel