View Single Post
 
Old 02-08-2022, 10:34 PM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2019
Expert
 
Join Date: Aug 2014
Posts: 4,144
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

OK The following will do that, however it will not be formatted in the same manner with each line a separate paragraph indented with spaces. It will be formatted to look the same using a pargraph format with a half inch indent.

Code:
Option Explicit

Sub ReplacePara()
Dim lPara As Long
Dim oRng As Range
Dim oCC As ContentControl
    With ActiveDocument
        For lPara = .Paragraphs.Count To 1 Step -1
            If InStr(1, .Paragraphs(lPara).Range.Text, _
                     "Nature and Necessity") > 0 Then
                Set oRng = .Paragraphs(lPara).Range
                oRng.MoveStart wdParagraph
                Exit For
            End If
        Next lPara
        For lPara = .Paragraphs.Count To 1 Step -1
            If InStr(1, .Paragraphs(lPara).Range.Text, _
                     "*****THIS IS A COMPLETE UNDERTAKING*****") > 0 Then
                oRng.End = .Paragraphs(lPara).Range.End - 1
                Exit For
            End If
        Next lPara
        oRng.Select
        oRng.ParagraphFormat.LeftIndent = InchesToPoints(0.5)
        oRng.Font.Bold = False
        oRng.Text = GetExcelB45Data
    End With
End Sub

Private Function GetExcelB45Data() As String
Dim strWorkbook As String: strWorkbook = "C:\Path\Job Aid Bay.xlsm" 'The path of the workbook
Dim xlApp As Object
Dim xlBook As Object
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    Set xlBook = xlApp.Workbooks.Open(FileName:=strWorkbook)
    xlApp.Visible = True
    GetExcelB45Data = xlBook.Sheets("MAIN").Range("B45") 'the Excel cell to copy
    xlBook.Close savechanges:=False
lbl_Exit:
    Err.Clear
    Set xlBook = Nothing
    Set xlApp = Nothing
    Exit Function
End Function
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote