C# Snippets

Frame_CorrectPosition

Public Function Frame_CorrectPosition(ByRef objDocument As Word.Document, _
                                      ByVal objFrame As Word.Frame, _
                                      ByVal sngHorizontalPosition As Single, _
                                      ByVal sngHorizontalDistanceFromText As Single, _
                                      ByVal sngVerticalPosition As Single, _
                                      ByVal sngVerticalDistanceFromText As Single) _
                                      As Boolean

    Try
        Call Tracer_Add2("SUBROUTINE", System.Reflection.MethodBase.GetCurrentMethod.Name & " start")
        If My.Settings.ERROR_OCCURRED = True Then Exit Function

        If ((objFrame.HorizontalPosition > sngHorizontalPosition - 2) And _
            (objFrame.HorizontalPosition < sngHorizontalPosition + 2)) And _
           ((objFrame.HorizontalDistanceFromText > sngHorizontalDistanceFromText - 2) And _
            (objFrame.HorizontalDistanceFromText < sngHorizontalDistanceFromText + 2)) And _
           ((objFrame.VerticalPosition > sngVerticalPosition - 2) And _
             (objFrame.VerticalPosition < sngVerticalPosition + 2)) And _
           ((objFrame.VerticalDistanceFromText > sngVerticalDistanceFromText - 2) And _
            (objFrame.VerticalDistanceFromText < sngVerticalDistanceFromText + 2)) Then

            Return True
        Else
            Return False
        End If

    Catch ex As Exception
        Call modMessages.Exception(System.Reflection.MethodBase.GetCurrentMethod, Nothing, ex)
        Return False
    End Try
End Function

Frame_Exists

Public Function Frame_Exists(ByRef objDocument As Word.Document, _
                             ByVal objRange As Word.Range, _
                             ByVal sngWidthMin As Single, _
                             ByVal sngWidthMax As Single, _
                             ByVal sContainsText As String) _
                             As Integer

    'this returns the frame number

    Dim iframeno As Integer
    Dim objframe As Word.Frame
    Dim stext As String

    Try
        Call Tracer_Add2("SUBROUTINE", System.Reflection.MethodBase.GetCurrentMethod.Name & " start")
        If My.Settings.ERROR_OCCURRED = True Then Exit Function

        If objRange.Frames.Count > 0 Then
            For iframeno = 1 To objRange.Frames.Count
                objframe = objRange.Frames(iframeno)
                stext = objframe.Range.Text

                If Frame_IsNotTableObject(objframe) Then
                    If (objframe.Width > sngWidthMin) And _
                       (objframe.Width < sngWidthMax) And _
                       (stext.IndexOf(sContainsText) > -1) Then

                        Return iframeno
                    End If
                End If
            Next iframeno
        End If

        Return 0

    Catch ex As System.Exception
        Call modMessages.Exception(System.Reflection.MethodBase.GetCurrentMethod, Nothing, ex)
        Return -1
    End Try
End Function

Frame_Insert

Inserts a frame at the current position in the active document.

Public Sub Frame_Insert(ByRef objDocument As Word.Document, _
                        ByVal sngWidth As Single, _
                        ByVal sngHeight As Single)

    Dim objtextboxshape As Word.Shape

    Try
        Call Tracer_Add2("SUBROUTINE", System.Reflection.MethodBase.GetCurrentMethod.Name & " start")
        If My.Settings.ERROR_OCCURRED = True Then Exit Sub

        objtextboxshape = objDocument.Shapes.AddTextbox(Office.MsoTextOrientation.msoTextOrientationHorizontal, _
                                                        50, 134.9, 100, 50)

        objtextboxshape.ConvertToFrame()

        With objDocument.Frames(1)
            .WidthRule = Word.WdFrameSizeRule.wdFrameExact
            .Width = sngWidth  'CentimetersToPoints(4.28)

            .HeightRule = Word.WdFrameSizeRule.wdFrameAuto
            .Height = sngHeight

            .HorizontalPosition = 0 'CentimetersToPoints(1.5)

            .RelativeHorizontalPosition = Word.WdRelativeHorizontalPosition.wdRelativeHorizontalPositionMargin
            .HorizontalDistanceFromText = gApplicationWord.CentimetersToPoints(0.76)

            .VerticalPosition = 0 'CentimetersToPoints(0.15)
            .RelativeVerticalPosition = Word.WdRelativeVerticalPosition.wdRelativeVerticalPositionParagraph
            .VerticalDistanceFromText = 0 'CentimetersToPoints(0.32)

            .LockAnchor = False
            .TextWrap = True

            .Borders(Word.WdBorderType.wdBorderTop).LineStyle = Word.WdLineStyle.wdLineStyleNone
            .Borders(Word.WdBorderType.wdBorderLeft).LineStyle = Word.WdLineStyle.wdLineStyleNone
            .Borders(Word.WdBorderType.wdBorderBottom).LineStyle = Word.WdLineStyle.wdLineStyleNone
            .Borders(Word.WdBorderType.wdBorderRight).LineStyle = Word.WdLineStyle.wdLineStyleNone
        End With

    Catch ex As Exception
        Call modMessages.Exception(System.Reflection.MethodBase.GetCurrentMethod, Nothing, ex)
    End Try
End Sub

Frame_IsNotTableObject

Public Function Frame_IsNotTableObject(ByVal objFrame As Word.Frame) As Boolean
    Dim sngwidth As Single
    Try
        sngwidth = objFrame.Width
        Return True

    Catch ex As Exception
        Return False
    End Try
End Function

Frame_Return

Public Function Frame_Return(ByRef objDocument As Word.Document, _
                             ByVal objRange As Word.Range, _
                             ByVal sngWidthMin As Single, _
                             ByVal sngWidthMax As Single) As Word.Frame

    Dim iframeno As Integer
    Dim objframe As Word.Frame

    Try
        Call Tracer_Add2("SUBROUTINE", System.Reflection.MethodBase.GetCurrentMethod.Name & " start")
        If My.Settings.ERROR_OCCURRED = True Then Return Nothing

        If (objRange.Frames.Count = 0) Then
            'display message
            Return Nothing
        End If

        For iframeno = 1 To objRange.Frames.Count
            objframe = objRange.Frames(iframeno)

            If (objframe.Width > sngWidthMin And objframe.Width < sngWidthMax) Then
                Return objframe
                Exit Function
            End If

        Next iframeno

        Return Nothing

    Catch ex As System.Exception
        Call modMessages.Exception(System.Reflection.MethodBase.GetCurrentMethod, Nothing, ex)
        Return Nothing
    End Try
End Function

Frame_Update

Public Sub Frame_Update(ByRef objDocument As Word.Document, _
                        ByVal objFrame As Word.Frame, _
                        ByVal sText As String)

    Dim objRange As Word.Range

    Try
        Call Tracer_Add2("SUBROUTINE", System.Reflection.MethodBase.GetCurrentMethod.Name & " start")
        If My.Settings.ERROR_OCCURRED = True Then Exit Sub

        objRange = objFrame.Range
        objRange.Text = sText

    Catch ex As Exception
        Call modMessages.Exception(System.Reflection.MethodBase.GetCurrentMethod, Nothing, ex)
    End Try
End Sub

FromColor

Public Shared Function FromColor(ByVal objColor As System.Drawing.Color) As Word.WdColor

   FromColor = _
      CType(Microsoft.VisualBasic.RGB(objColor.R, objColor.G, objColor.B), Word.WdColor)

End Function

FromRGB

Public Shared Function FromRGB(ByVal iRGBRed As Integer, _
                               ByVal iRGBGreen As Integer, _
                               ByVal iRGBBlue As Integer) As Word.WdColor

   FromRGB = _
      CType(Microsoft.VisualBasic.RGB(iRGBRed, iRGBGreen, iRGBBlue), Word.WdColor)

End Function

Picture_Insert

Public Function Picture_Insert(ByVal objShapesCollection As Word.Shapes, _
                               ByVal sFolderPath As String, _
                               ByVal sFileName As String, _
                               ByVal sngLeft As Single, _
                               ByVal sngTop As Single) As Boolean

    Try

        objShapesCollection.AddPicture(FileName:=sFolderPath & sFileName, _
                                       LinkToFile:=False, _
                                       Left:=CType(sngLeft, Object), _
                                       Top:=CType(sngTop, Object))

    Catch ex As Exception
        Call modMessages.Exception(System.Reflection.MethodBase.GetCurrentMethod, Nothing, ex)
    End Try
End Function

Shape_AddPicture

Public Function Shape_AddPicture(ByVal objShapesCollection As Word.Shapes, _
                                 ByVal sFolderPath As String, _
                                 ByVal sFileName As String, _
                                 ByVal sngWidth As Single, _
                                 ByVal sngHeight As Single, _
                                 ByVal sngHorizontalLeft As Single, _
                                 ByVal sngVerticalTop As Single, _
                                 ByVal rgeAnchor As Word.Range) As Word.Shape

    Dim objshape As Word.Shape

    Try
        gApplicationWord.ScreenUpdating = False

        If (rgeAnchor Is Nothing) Then
            'no anchor
            objshape = objShapesCollection.AddPicture(FileName:=sFolderPath & sFileName, _
                                                      LinkToFile:=False, _
                                                      Left:=CType(sngHorizontalLeft, Object), _
                                                      Top:=CType(sngVerticalTop, Object), _
                                                      Width:=CType(sngWidth, Object), _
                                                      Height:=CType(sngHeight, Object))
        Else
            'with anchor
            objshape = objShapesCollection.AddPicture(FileName:=sFolderPath & sFileName, _
                                                      LinkToFile:=False, _
                                                      Left:=CType(sngHorizontalLeft, Object), _
                                                      Top:=CType(sngVerticalTop, Object), _
                                                      Width:=CType(sngWidth, Object), _
                                                      Height:=CType(sngHeight, Object), _
                                                      Anchor:=CType(rgeAnchor, Object))
        End If

        'Documentation says the relatives are these but they are not
        'Width = Word.WdRelativeHorizontalPosition.wdRelativeHorizontalPositionPage, _
        'Height = Word.WdRelativeVerticalPosition.wdRelativeVerticalPositionPage)

        'Width = Word.WdRelativeHorizontalPosition.wdRelativeHorizontalPositionColumn, _
        'Height = Word.WdRelativeVerticalPosition.wdRelativeVerticalPositionPage)

        objshape.RelativeVerticalPosition = Word.WdRelativeVerticalPosition.wdRelativeVerticalPositionPage
        objshape.Top = sngVerticalTop

        objshape.RelativeHorizontalPosition = Word.WdRelativeHorizontalPosition.wdRelativeHorizontalPositionPage
        objshape.Left = sngHorizontalLeft

        Return objshape

    Catch ex As System.Exception
        Call modMessages.Exception(System.Reflection.MethodBase.GetCurrentMethod, Nothing, ex)
        Return Nothing
    Finally
        gApplicationWord.ScreenUpdating = True
    End Try
End Function

Shape_Delete

Public Sub Shape_Delete(ByVal objShapes As Word.Shapes, _
                        ByVal sShapeName As String)

    Try
        If (Shape_Exists(objShapes, sShapeName) = True) Then
            objShapes.Item(sShapeName).Delete()
        End If

    Catch ex As Exception
        Call modMessages.Exception(System.Reflection.MethodBase.GetCurrentMethod, Nothing, ex)
    End Try
End Sub

Shape_Exists

Public Function Shape_Exists(ByVal objShapes As Word.Shapes, _
                             ByVal sShapeName As String) _
                             As Boolean

    Dim lcount As Long

    Try
        If (objShapes Is Nothing) Then Exit Function

        For lcount = 1 To objShapes.Count
            If (objShapes(lcount).Name = sShapeName) Then
                Return True
            End If
        Next lcount

        Return False

    Catch ex As Exception
        Call modMessages.Exception(System.Reflection.MethodBase.GetCurrentMethod, Nothing, ex)
        Return False
    End Try
End Function

Shape_Format

Public Sub Shape_Format(ByVal objShape As Word.Shape)

    Try
        With objShape
            .LockAnchor = 1  '
            .LockAspectRatio = Microsoft.Office.Core.MsoTriState.msoTrue
            .WrapFormat.AllowOverlap = 1
            '.WrapFormat.DistanceBottom
            '.WrapFormat.DistanceLeft
            '.WrapFormat.DistanceRight
            '.WrapFormat.DistanceTop
        End With

    Catch ex As Exception
        Call modMessages.Exception(System.Reflection.MethodBase.GetCurrentMethod, Nothing, ex)
    End Try
End Sub

Shape_Position

Public Sub Shape_Position(ByVal objShape As Word.Shape, _
                          ByVal sngTop As Single, _
                          ByVal wdRelativeVertical As Word.WdRelativeVerticalPosition, _
                          ByVal sngLeft As Single, _
                          ByVal wdRelativeHorizontal As Word.WdRelativeHorizontalPosition)

    Try
        With objShape
            .Top = sngTop
            .RelativeVerticalPosition = wdRelativeVertical

            .Left = sngLeft
            .RelativeHorizontalPosition = wdRelativeHorizontal
        End With

    Catch ex As Exception
        Call modMessages.Exception(System.Reflection.MethodBase.GetCurrentMethod, Nothing, ex)
    End Try
End Sub

Shape_Size

Public Sub Shape_Size(ByVal objshape As Word.Shape, _
                      ByVal sngHeight As Single, _
                      ByVal sngWidth As Single)

    Try
        If (objshape Is Nothing) Then Exit Sub

        With objshape
            .Height = sngHeight
            .Width = sngWidth
        End With

    Catch ex As Exception
        Call modMessages.Exception(System.Reflection.MethodBase.GetCurrentMethod, Nothing, ex)
    End Try
End Sub

Shapes_Delete

Public Sub Shapes_Delete(ByVal objShapes As Word.Shapes, _
                Optional ByVal sOnlyThisPrefix As String = "", _
                Optional ByVal alArrayList As System.Collections.ArrayList = Nothing)

    Dim sshapename As String = ""

    Try
        For icount As Integer = objShapes.Count To 1 Step -1
            sshapename = objShapes.Item(icount).Name

            'if the shape has been grouped then individual shapes cannot be deleted
            If (alArrayList.Contains(sshapename) = True) Then
                Tracer_Add2("SHAPES", sshapename & " NOT deleted", True)

            Else
                If (sOnlyThisPrefix.Length = 0) Then
                    objShapes.Item(icount).Delete()
                    Tracer_Add2("SHAPES", sshapename & " deleted", True)
                Else
                    If (sshapename.Length > sOnlyThisPrefix.Length) Then
                        If (sshapename.Substring(0, sOnlyThisPrefix.Length) = sOnlyThisPrefix) Then
                            objShapes.Item(icount).Delete()
                            Tracer_Add2("SHAPES", sshapename & " deleted", True)
                        End If
                    End If
                End If
            End If

        Next icount

    Catch ex As System.Exception
        Call modMessages.Exception(System.Reflection.MethodBase.GetCurrentMethod, Nothing, ex)
    End Try
End Sub

Shapes_RangeContains

Public Function Shapes_RangeContains(ByVal objRange As Word.Range) As Boolean

    Dim iNoOfShapes As Integer

    Try
        iNoOfShapes = objRange.ShapeRange.Count
        If (iNoOfShapes = 0) Then Return False
        If (iNoOfShapes > 0) Then Return True

    Catch ex As Exception
        Return False
    End Try
End Function

TextBox_Exists

Public Function TextBox_Exists(ByRef objDocument As Word.Document, _
                               ByVal objRange As Word.Range, _
                               ByVal sngHeightMin As Single, _
                               ByVal sContainsText As String) As Boolean

    Dim objshape As Word.Shape = Nothing
    Dim stext As String

    Try
        Call Tracer_Add2("SUBROUTINE", System.Reflection.MethodBase.GetCurrentMethod.Name & " start")
        If My.Settings.ERROR_OCCURRED = True Then Exit Function

        If modWordObjectModel.Shapes_RangeContains(objRange) Then
            objshape = objRange.ShapeRange(1)

            If (objshape.Type = Microsoft.Office.Core.MsoShapeType.msoTextBox) Then

                objRange = objshape.TextFrame.TextRange
                stext = objRange.Text

                If (objshape.Height > sngHeightMin) And _
                   (stext.IndexOf(sContainsText) > -1) Then

                    Return True
                End If
            Else
                Return False
            End If
        Else
            Return False
        End If

    Catch ex As System.Exception
        Call modMessages.Exception(System.Reflection.MethodBase.GetCurrentMethod, Nothing, ex)
        Return False
    End Try
End Function

TextBox_Insert

Public Sub TextBox_Insert(ByRef objDocument As Word.Document)

    Dim objrange As Word.Range
    Dim objwordtemplate As Word.Template
    Dim objtextboxshape As Word.Shape
    Dim sauthorframetext As String

    Try
        objrange = objDocument.Sections(1).Range.Paragraphs(objDocument.Sections(1).Range.Paragraphs.Count - 1).Range
        objrange.Collapse(Word.WdCollapseDirection.wdCollapseEnd)
        objwordtemplate = CType(objDocument.AttachedTemplate, Word.Template)
        objwordtemplate.AutoTextEntries("BC-Cover Sidebar Text").Insert(objrange)

        objtextboxshape = modWordObjectModel.TextBox_Return(objDocument, _
                                                            objDocument.Sections(1).Range, _
                                                            410, 425, 150)
        objrange = objtextboxshape.TextFrame.TextRange

        objrange.MoveStartUntil("@", Word.WdConstants.wdForward)
        objrange.MoveStart(Word.WdUnits.wdParagraph, -3)

        sauthorframetext = objtextboxshape.TextFrame.TextRange.Text

        objtextboxshape.TextFrame.TextRange.Text = sauthorframetext
        objtextboxshape.TextFrame.TextRange.Style = "A-Name"

    Catch ex As System.Exception
        Call modMessages.Exception(System.Reflection.MethodBase.GetCurrentMethod, Nothing, ex)
    End Try
End Sub

TextBox_Return

Public Function TextBox_Return(ByRef objDocument As Word.Document, _
                               ByVal objRange As Word.Range, _
                               ByVal sngLeftMin As Single, _
                               ByVal sngLeftMax As Single, _
                               ByVal sngHeightMin As Single) As Word.Shape

    Dim ishapeno As Integer
    Dim objtextboxshape As Word.Shape

    Try
        Call Tracer_Add2("SUBROUTINE", System.Reflection.MethodBase.GetCurrentMethod.Name & " start")
        If My.Settings.ERROR_OCCURRED = True Then Return Nothing

        If modWordObjectModel.Range_ContainsShapes(objRange) = False Then
            'display a message
            Return Nothing
        End If

        For ishapeno = 1 To objRange.ShapeRange.Count
            objtextboxshape = objRange.ShapeRange(ishapeno)

            If objtextboxshape.Left > sngLeftMin And objtextboxshape.Left < sngLeftMax Then
                If objtextboxshape.Height > sngHeightMin Then
                    Return objtextboxshape
                End If
            End If

        Next ishapeno

        Return Nothing

    Catch ex As System.Exception
        Call modMessages.Exception(System.Reflection.MethodBase.GetCurrentMethod, Nothing, ex)
        Return Nothing
    End Try
End Function

TextBox_Update

Public Sub TextBox_Update(ByRef objDocument As Word.Document, _
                          ByVal objTextBoxShape As Word.Shape)

    Dim objRange As Word.Range

    Try
        Call Tracer_Add2("SUBROUTINE", System.Reflection.MethodBase.GetCurrentMethod.Name & " start")
        If My.Settings.ERROR_OCCURRED = True Then Exit Sub

        objRange = objTextBoxShape.TextFrame.TextRange
        objRange.Text = "this text"

    Catch ex As Exception
        Call modMessages.Exception(System.Reflection.MethodBase.GetCurrentMethod, Nothing, ex)
    End Try
End Sub

TextBoxes_CorrectPosition

Public Function TextBox_CorrectPosition(ByRef objDocument As Word.Document, _
                                        ByVal objTextBoxShape As Word.Shape, _
                                        ByVal sngLeftMin As Single, _
                                        ByVal sngLeftMax As Single) _
                                        As Boolean

    Try
        Call Tracer_Add2("SUBROUTINE", System.Reflection.MethodBase.GetCurrentMethod.Name & " start")
        If My.Settings.ERROR_OCCURRED = True Then Return Nothing

        If (objTextBoxShape.Left > sngLeftMin And _
            objTextBoxShape.Left < sngLeftMax) Then

            Return True
        End If

        Return False

    Catch ex As Exception
        Call modMessages.Exception(System.Reflection.MethodBase.GetCurrentMethod, Nothing, ex)
        Return False
    End Try
End Function

---

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