VBA Snippets

Delete

Removes a particular section from the active document.

Public Sub Section_Delete()
Const sPROCNAME As String = "Section_Delete"
   On Error GoTo AnError


   If gbDEBUG = False Then Exit Sub
AnError:
   Call Error_Handle(msMODULENAME, sPROCNAME, 1,
        "")
End Sub

FooterAdd

Adds a footer to the current section.

Public Sub Section_FooterAdd(sText As String, _
                             Optional sFooterType As String = "PRIMARY")
Const sPROCNAME As String = "Section_FooterAdd"
   On Error GoTo AnError
   
'activewindow.activepane.view.seekview = wdseekcurrentpageheaderfooter
   With ActiveDocument.Sections(1)
      If sFooterType = "PRIMARY" Then .Headers(wdHeaderFooterPrimary).Range.Text = sText
      If sFooterType = "FIRST" Then .Headers(wdHeaderFooterPrimary).Range.Text = sText
      If sFooterType = "ODD" Then .Headers(wdHeaderFooterPrimary).Range.Text = sText
   End With
   If gbDEBUG = False Then Exit Sub
AnError:
   Call Error_Handle(msMODULENAME, sPROCNAME, 1,
        "add a footer to the current section of the document")
End Sub

FooterEmptyIsIt

Determines if the footer of the current section is empty.

Public Function Section_FooterEmptyIsIt() As Boolean
Const sPROCNAME As String = "Section_FooterEmptyIsIt"

   On Error GoTo AnError
   If ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range.Text <> vbCr Then
      Section_FooterEmptyIsIt = True
   Else
      Section_FooterEmptyIsIt = False
   End If
   If gbDEBUG = False Then Exit Function
AnError:
   Call Error_Handle(msMODULENAME, sPROCNAME, 1,
        "determine if the footer of the current section is empty")
End Function

FooterFieldsAny

Determines if there are any fields in the footer for the current section.

Public Function Section_FooterFieldsAny() As Boolean
Const sPROCNAME As String = "Section_FooterFieldsAny"
   On Error GoTo AnError


   If gbDEBUG = False Then Exit Sub
AnError:
   Call Error_Handle(msMODULENAME, sPROCNAME, 1,
        "determine if there are any fields in the footer for the current section")
End Sub

FooterSet

Defines the footer for the current section to be the same as the footer in the previous section.

Public Sub Section_FooterSet(bSameAsPrevious As Boolean)
Const sPROCNAME As String = "Section_FooterSet"

   On Error GoTo AnError
   Selection.Range.Sections(1).Footers(wdHeaderFooterPrimary) _
                              .LinkToPrevious = bSameAsPrevious
   If gbDEBUG = False Then Exit Sub
AnError:
   Call Error_Handle(msMODULENAME, sPROCNAME, 1,
        "define the footer for the current section to be the same as the footer in the" & _
        "in the previous section")
End Sub

GetTabstop

Public Function Section_GetTabstop(ByVal oTargetSection As Word.Section) As Single
Const sPROCNAME As String = "getTabstop"

   Dim sngPageWidth As Single
   Dim sngMargin As Single

   On Error GoTo ErrorHandler

   sngPageWidth = oTargetSection.PageSetup.PageWidth
   sngMargin = oTargetSection.PageSetup.LeftMargin + oTargetSection.PageSetup.RightMargin
   Section_GetTabstop = sngPageWidth - sngMargin

   Exit Function
ErrorHandler:
   Call Error_Handle(msMODULENAME, sPROCNAME, Err.Number, Err.Description)
End Function

HeaderEmptyIsIt

Determines if the header for the current section contains any text.

Public Function Section_HeaderEmptyIsIt() As Boolean
Const sPROCNAME As String = "Section_HeaderEmptyIsIt"

   On Error GoTo AnError
   If ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text <> vbCr Then
      Section_HeaderEmptyIsIt = True
   Else
      Section_HeaderEmptyIsIt = False
   End If
   If gbDEBUG = False Then Exit Function
AnError:
   Call Error_Handle(msMODULENAME, sPROCNAME, 1,
        "determine if the header for the current section contains any text")
End Function

HeaderFieldsAny

Determines if there are any fields in the header for the current section.

Public Function Section_HeaderFieldsAny() As Boolean
Const sPROCNAME As String = "Section_HeaderFieldsAny"

Dim fldField As Field
   On Error GoTo AnError
   For Each fldField In ActiveDocument.Sections(1) _
                          .Headers(wdHeaderFooterPrimary).Range.Fields
      If fldField.Type = wdFieldAddin Then
'         MsgBox fldField.Code.Text
         MsgBox fldField.Data
      End If
   Next fldField
   If gbDEBUG = False Then Exit Function
AnError:
   Call Error_Handle(msMODULENAME, sPROCNAME, 1,
        "determines if there are any fields in the header for the current section")
End Function

HeaderFooterUpdate

The type of seek view can be either ?? Or ??.

Public Function Section_HeaderFooterUpdate(lSeekViewType As Long) As Boolean
Const sPROCNAME As String = "Section_HeaderFooterUpdate"

   On Error GoTo AnError
   ActiveWindow.ActivePane.View.SeekView = lSeekViewType
   Selection.WholeStory
   Selection.Fields.Update
   ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
   If gbDEBUG = False Then Exit Function
AnError:
   Call Error_Handle(msMODULENAME, sPROCNAME, 1,
      "")
End Function

HeaderSet

Defines the header for the current selection to be the same as the header in the previous section.

Public Sub Section_HeaderSet(bSameAsPrevious as Boolean)
Const sPROCNAME As String = "Section_HeaderSet"
   On Error GoTo AnError
 
   Selection.Range.Sections(1) _
      .Headers(wdHeaderFooterPrimary).LinkToPrevious = bSameAsPrevious

   If gbDEBUG = False Then Exit Sub
AnError:
   Call Error_Handle(msMODULENAME, sPROCNAME, 1,
        "define the header for the current section to be the same as the header in " & _
        "the previous section")
End Sub

OrientationGet

Public Function Section_OrientationGet() As String
   On Error GoTo AnError
   If Selection.PageSetup.Orientation = WdOrientation.wdOrientPortrait Then
      Section_OrientationGet = "Portrait"
   End If
   If Selection.PageSetup.Orientation = WdOrientation.wdOrientLandscape Then
      Section_OrientationGet = "Landscape"
   End If
   If gbDEBUG_ERRMSG = False Then Exit Function
AnError:
   Call Error_Handle("Section_OrientationGet", msMODULENAME, _
        "return the page orientation for the current section.")
End Function

OrientationSet

Public Sub Section_OrientationSet(ByVal sOrientation As String)
   On Error GoTo AnError
   If sOrientation = "Portrait" Then
      Selection.PageSetup.Orientation = WdOrientation.wdOrientPortrait
   End If

   If sOrientation = "Landscape" Then
      Selection.PageSetup.Orientation = WdOrientation.wdOrientLandscape
   End If
   If gbDEBUG_ERRMSG = False Then Exit Sub
AnError:
   Call Error_Handle("Section_OrientationSet", msMODULENAME, _
        "change the page orienation of the current section.")
End Sub

PageEvenUpdate

Updates all the fields in the "first" page header and footer.

Public Sub Section_PageEvenUpdate()
Const sPROCNAME As String = "Section_PageEvenUpdate"
   On Error GoTo AnError
   If Section_HeaderFooterExists(wdSeekFirstPageHeader) = True Then
      Call Section_HeaderFooterUpdate(wdSeekFirstPageHeader)
   End If

   If Section_HeaderFooterExists(wdSeekFirstPageFooter) = True Then
      Call Section_HeaderFooterUpdate(wdSeekFirstPageHeader)
   End If

   If gbDEBUG = False Then Exit Sub
AnError:
   Call Error_Handle(msMODULENAME, sPROCNAME, 1,
        "")
End Sub

PageFirstUpdate

Updates all the fields in the "first" page header and footer.

Public Sub Section_PageFirstUpdate()
Const sPROCNAME As String = "Section_PageFirstUpdate"

   On Error GoTo AnError
   If Section_HeaderFooterExists(wdSeekFirstPageHeader) = True Then 
      Call Section_HeaderFooterUpdate(wdSeekFirstPageHeader)
   End If

   If Section_HeaderFooterExists(wdSeekFirstPageFooter) = True Then 
      Call Section_HeaderFooterUpdate(wdSeekFirstPageHeader)
   End If

   If gbDEBUG = False Then Exit Sub
AnError:
   Call Error_Handle(msMODULENAME, sPROCNAME, 1,
        "")
End Sub

PagePrimaryUpdate

Updates all the fields in the "primary" page header and footer.

Public Sub Section_PagePrimaryUpdate()
Const sPROCNAME As String = "Section_PagePrimaryUpdate"

   On Error GoTo AnError
   If Section_HeaderFooterExists(wdSeekPrimaryHeader) = True Then 
      Call Section_HeaderFooterUpdate(wdSeekPrimaryHeader)
   End If

   If Section_HeaderFooterExists(wdSeekPrimaryFooter) = True Then 
      Call Section_HeaderFooterUpdate(wdSeekPrimaryFooter)
   End If 

   If gbDEBUG = False Then Exit Sub
AnError:
   Call Error_Handle(msMODULENAME, sPROCNAME, 1,
        "")
End Sub

Print

Prints the current section of the active document.

Public Sub Section_Print()
Const sPROCNAME As String = "Section_Print"
   On Error GoTo AnError


   If gbDEBUG = False Then Exit Sub
AnError:
   Call Error_Handle(msMODULENAME, sPROCNAME, 1,
        "print the current section of the active document")
End Sub

SectionNo

Public Function Sel_SectionNo() As Integer
   On Error GoTo AnError
   Sel_SectionNo = Application.Selection.Information(WdInformation.wdActiveEndSectionNumber)
   If gbDEBUG_ERRMSG = False Then Exit Function
AnError:
   Call Error_Handle("Sel_SectionNo", msMODULENAME, _
        ".")
End Function

---

© 2024 Better Solutions Limited. All Rights Reserved. © 2024 Better Solutions Limited Top