View Single Post
 
Old 02-07-2022, 05:26 AM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2019
Expert
 
Join Date: Aug 2014
Posts: 4,137
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

That is not an error message. It simply reports what is on the clipboard. Clearly you haven't copied the text from Excel as it is showing the code listing you copied from the forum.
If you want to include the collection of data from the worksheet then you may need to make some changes to:
Code:
Sub BayTag()
Dim sValue As String
    sValue = GetExcelData
    If Not sValue = "" Then
        If MsgBox("Paste the value :" & vbCr & sValue, vbYesNo) = vbYes Then
            AddPara ActiveDocument, sValue
        End If
    End If
End Sub

Private Function GetExcelData() 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
    GetExcelData = xlBook.Sheets("MAIN").Range("B12") 'the Excel cell to copy
    xlBook.Close savechanges:=False
lbl_Exit:
    Err.Clear
    Set xlBook = Nothing
    Set xlApp = Nothing
    Exit Function
End Function

Private Sub AddPara(oDoc As Document, sText As String)
Dim oRng As Range
Dim oShape As Range
Dim bProtected As Boolean
    'Unprotect the file
    If oDoc.Tables.Count < 3 Then
        MsgBox "Incompatible document", vbCritical
        GoTo lbl_Exit
    End If
    If Not oDoc.ProtectionType = wdNoProtection Then
        bProtected = True
        oDoc.Unprotect Password:=""
    End If
    Set oRng = oDoc.Tables(3).Range.Cells(2).Range
    oRng.End = oRng.End - 1

    'If you want to keep the content of the text box.....
    If oRng.ShapeRange.Count > 0 Then
        oRng.ShapeRange(1).Select
        Set oShape = oDoc.Tables(3).Range.Cells(4).Range
        oShape.Collapse 1
        oShape.Text = vbCr
        oShape.Collapse 0
        oShape.FormattedText = Selection.FormattedText
    End If
    '..... end of text box code

    oRng.Text = sText
    'Reprotect the document.
    If bProtected = True Then
        oDoc.Protect _
                Type:=wdAllowOnlyFormFields, _
                NoReset:=True, _
                Password:=""
    End If
lbl_Exit:
    Set oRng = Nothing
    Exit Sub
End Sub
__________________
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