Useful Macros
This page contains a selection of simple Macros I have found useful. For each Macro just copy the text into the VB editor and run from within word or Excel.
Resize all Images in a Word Document
Click here for a text file of this script, description below
This is particularly useful if you have just converted an HTML file with lots of images into a word document, only to discover that when you move the file to your laptop all the images become corrupted (because they are linked - if you move a file with linked content the formatting will be lost), so you import and embed them, only to discover that their sizes are all messed up.
This macro will run through your word file and change every image to the size you set.
Sub ResizeImage()
' 09/05/2007 by EHopper
'
'Declare Picture Variable
Dim MyPicture As InlineShape
'Here we go throught the document, finding the images and changing them
For Each MyPicture In ActiveDocument.InlineShapes
MyPicture.Select
Selection.InlineShapes(1).Height = 54.15
Selection.InlineShapes(1).Width = 72.55
Next MyPicture
ActiveDocument.Repaginate
End Sub
Change the style of all tables in your Word Document
Click here for a text file of this script, description below
This script will run through your entire word document and re-set the style of all your tables to a pre-set format. In the script 'EHReport' is the name of a table style I saved earlier.
Sub ChangeAllTablesToStyle()
Dim myTable As Table
For Each myTable In ActiveDocument.Tables
myTable.Select
Selection.Style = ActiveDocument.Styles("EHReport")
Next myTable
ActiveDocument.Repaginate
End Sub
Join rows in Excel without loosing data
Click here for a text file of this script, description below
This isn't a script of mine but one by David McRitchie, however it is very useful when you want to combine multiple rows in Excel without deleting everything but the content in the top left cell. To use select the cells and then run the Macro; it may be an idea to set a shortcut if you use this a lot.
Sub JoinRows()
'David McRitchie 2003-06-16 programming, documented in
' http://www.mvps.org/dmcritchie/excel/join.htm
'Join cells with CHAR(10) to cell above within selection
Dim iCols As Long, mRow As Long, lastcell As Range
Dim iAnswer As Variant, l As Long, im As Long
Dim ic As Long, ir As Long, iRows As Long, trimmed As String
Dim response As Long
If Selection.Columns.Count <> Cells.Columns.Count Then
response = MsgBox("You did not select entire rows" & Chr(10) _
& "Press OK to continue anyway (rows may not line up)" _
& Chr(10) & "Press Cancel to terminate", vbOKCancel)
If response = vbCancel Then Exit Sub
End If
Application.ScreenUpdating = False
On Error Resume Next
iRows = Selection.Rows.Count
Set lastcell = Cells.SpecialCells(xlLastCell)
mRow = lastcell.Row
If mRow < iRows Then iRows = mRow 'not best but better than nothing
iCols = Selection.Columns.Count
For ir = iRows To 2 Step -1
For ic = 1 To iCols
If Trim(Selection.Item(ir, ic).Value) <> "" Then
If Trim(Selection.Item(ir - 1, ic).Value) <> "" Then
Selection.Item(ir - 1, ic).Value = Selection.Item(ir - 1, ic) _
& Chr(10) & Selection.Item(ir, ic)
Else
Selection.Item(ir - 1, ic).Value = Selection.Item(ir, ic)
End If
End If
Next ic
Selection.Item(ir, 1).Resize(1, iCols).Delete
Next ir
Selection.Resize(1).Select
With Selection
.VerticalAlignment = xlTop
.WrapText = True
End With
Application.ScreenUpdating = True
End Sub