Mister Ian's Weblog

Category: Word

  • Word to Excel Breaks

    1. In Word replace all the paragraph marks with a unique character.
    2. In Excel replace the unique character with the Excel line break character.
    3. In the Replace field, enter the following Alt code: Alt+0010. This code enters in a single line break. You will not see this character but the cursor may change.

    Note, to enter an Alt code, hold down the Alt key as you type the digits on the numeric keypad. It may help to have Num Lock on.

    Reference

  • Clean Up and Assign Template

    Sub cleanup()
'
' cleanup Macro
'
'With ActiveDocument.Styles(wdStyleNormal).Font
    With ActiveDocument.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientPortrait
        .TopMargin = InchesToPoints(0.7)
        .BottomMargin = InchesToPoints(0.7)
        .LeftMargin = InchesToPoints(1)
        .RightMargin = InchesToPoints(1)
        .Gutter = InchesToPoints(0)
        .HeaderDistance = InchesToPoints(0.4)
        .FooterDistance = InchesToPoints(0.4)
        .PageWidth = InchesToPoints(8.5)
        .PageHeight = InchesToPoints(11)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
        .TwoPagesOnOne = False
        .BookFoldPrinting = False
        .BookFoldRevPrinting = False
        .BookFoldPrintingSheets = 1
        .GutterPos = wdGutterPosLeft
    End With
    With ActiveDocument
        .UpdateStylesOnOpen = True
        .AttachedTemplate = _
            "\pathtotemplatetemplate.dotx"
        .XMLSchemaReferences.AutomaticValidation = True
        .XMLSchemaReferences.AllowSaveAsXMLWithoutValidation = False
    End With
End Sub

  • Document Clean Up

    Here’s a general bunch of stuff to clean up a document inherited from someone.

    Sub docfix()
'
' docfix Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = " ^t^t"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = " ^t"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "^l"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "  "
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "^p^t"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

  • Delete Unused Styles

    I don’t recall where I found this on the interwebs. It seems to work well. If anyone finds the original source, please comment and I’ll give the credit where credit is due!

    Sub DeleteUnusedStyles()
    Dim oStyle As Style
   
    On Error GoTo ErrorHandler
   
    Application.ScreenUpdating = False ' try to speed it up
 
    For Each oStyle In ActiveDocument.Styles
        'Only check out non-built-in styles
        If oStyle.BuiltIn = False Then
            With ActiveDocument.Content.Find
                .ClearFormatting
                .Style = oStyle.NameLocal
                .Execute FindText:="", Format:=True
                If .Found = False Then oStyle.Delete
            End With
        End If
    Next oStyle
   
ErrorHandler:
    Application.ScreenUpdating = False
   
End Sub

  • Table Cleanup

    This is a moderately generic macro to clean up tables.

    Sub tfixtest()
'
' tfixtest Macro
'
 
On Error GoTo ErrorHandler
    Selection.Tables(1).Select
    Selection.Rows.HeightRule = wdRowHeightAuto
    Selection.Rows.AllowBreakAcrossPages = False
       
    ' Selection.SelectCell
    Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
   
    With Selection.ParagraphFormat
        ' .RightIndent = InchesToPoints(0)
        ' .LeftIndent = InchesToPoints(0)
       
        .SpaceBefore = 1
        .SpaceBeforeAuto = False
        .SpaceAfter = 1
        .SpaceAfterAuto = False
        .CharacterUnitRightIndent = 0
               
        
    End With
   
    
    Selection.Cells.VerticalAlignment = wdCellAlignVerticalTop
    Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow)
    Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow)
    Selection.Font.Name = "Arial"
    Selection.Font.Size = 10
   
    
    
    With Selection.Tables(1)
        .TopPadding = InchesToPoints(0.04)
        .BottomPadding = InchesToPoints(0.04)
        .LeftPadding = InchesToPoints(0.06)
        .RightPadding = InchesToPoints(0.06)
        .Spacing = 0
        .AllowPageBreaks = True
        .AllowAutoFit = True
    End With
   

    ' Selection.Style = ActiveDocument.Styles("Table Text Left (Alt-T)")
       
    
ErrorHandler:
 
      
End Sub

    Below is some stuff that I was messing with but isn’t fully sorted out yet.

    Sub tablefun()
 
Dim oTable As Table
Dim oCell As Variant
 
oTable.Select
 
 
For Each oCell In oTable.Range.Cells
    oCell.Width = InchesToPoints(1)
    oCell.Shading.BackgroundPatternColorIndex = wdBlue
    oCell.Range.Font.Name = "Arial"
    oCell.Range.Font.Size = 20
    oCell.Text = "ack"
Next oCell
 
 
End Sub
 
Sub FixAllTables()
     Dim tbl As Table
    
     For Each tbl In ActiveDocument.Tables
    
         Selection.Tables(1).Select
        
         
'         For Each oCell In oTable.Range.Cells
'  oCell.Width = InchesToPoints(1)
'  oCell.Shading.BackgroundPatternColorIndex = wdBlue
'  oCell.Range.Font.Name = "Arial"
'  oCell.Range.Font.Size = 20
' Next oCell
 
         Selection.Tables(1).Select
        
         With tbl.Cells(1)
        
      '   With Selection.Cells(1)
            .VerticalAlignment = wdCellAlignVerticalTop
            .TopPadding = InchesToPoints(0.06)
            .BottomPadding = InchesToPoints(0.06)
            .LeftPadding = InchesToPoints(0.04)
            .RightPadding = InchesToPoints(0.04)
            .WordWrap = False
            .FitText = False
         End With
        
         Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow)
       
         Selection.Rows.HeightRule = wdRowHeightAuto
         Selection.Rows.Height = InchesToPoints(0)
         Selection.Rows.AllowBreakAcrossPages = False
                    
         Next
End Sub