Microsoft Office Forums - View Single Post - PLEASE HELP: Run-time error '5941', The requested member of the collection does not exist

newb · 06-03-2021, 09:02 AM

thanks for the reply. I'm not sure the answer to your question, i actually inherited this code from someone who wrote it years ago so i am not familiar with all of it. the functionality is transferring information to the bookmarks in word which are named after named cells in excel.

I had a separate thread that asked about a separate issue, but the thread was closed. if anyone could help me with the formatting issue i am also having, i would appreciate it. thanks so much:

I am trying to import data from excel to word. the excel cells that i want transferred are named and i built out tables in word that have the corresponding "cells" bookmarked.

for the numeric data, i have an issue. some are percentages, some need two decimals, some i would prefer as whole numbers. the issue is that certain items that i would need 2 decimal places for come through as whole number. so 1.15 comes in as 1. 1.2 as 1. .65 as 1, etc.... i inherited the code for this and tried to edit it but had no luck. does anyone know how i can have the formatting change based on how it is displayed in excel? also, is there a certain way i should format in excel so that the data transfers as intended?

I have posted the entire code below:

Code:

Dim oExcel As Object
Dim eBook As Object

Dim formatCell As String
Sub ImportData()

    Dim ExcelFileName As String
    Dim Dated As Date
    
    ExcelFileName = SelectFile("Excel", "xlsm")
    If ExcelFileName = "" Then MsgBox "Excel file not selected - Import canceled.", vbInformation: Exit Sub
    
    Dim wDoc As Document
    
    Set wDoc = ActiveDocument
    Set oExcel = CreateObject("Excel.Application")
    Set eBook = oExcel.Workbooks.Open(ExcelFileName)
    
    'oExcel.Visible = True
    
    Application.StatusBar = "Please be patient as the data is imported..."
    Application.ScreenUpdating = False
    'On Error GoTo 10
    
    Dim tbl As Table
    Dim iSource As String
    Dim fValue As String
    
    Dim cl As Cell
    
    Dim item As Bookmark
    Dim itemName As String
    Dim a As Long
    
    For a = wDoc.Bookmarks.Count To 1 Step -1
            Set item = wDoc.Bookmarks(a)
                itemName = item.Name
            Set cl = item.Range.Cells(1)
                fValue = RangeValue(itemName)
                    If fValue <> "" Then
                        If IsNumeric(fValue) Then
                            Select Case formatCell
                                Case "Percentage"
                                    item.Range.Text = Format(fValue, formatCell)
                                Case "0%"
                                    item.Range.Text = Format(fValue, formatCell)
                                Case "0.0%"
                                    item.Range.Text = Format(fValue, formatCell)
                                Case "0.00%"
                                    item.Range.Text = Format(fValue, formatCell)
                                Case "0.00""x"""
                                    item.Range.Text = Format(fValue, "0.00""x""")
                                Case Else
                                    item.Range.Text = Format(fValue, "#,##0;(#,##0);"" - """)
                            End Select
                        Else
                            item.Range.Text = fValue
                        End If
                    End If
            wDoc.Bookmarks.Add itemName, cl.Range
    Next
    
    eBook.Close False
    oExcel.Quit
    Application.ScreenUpdating = True
    
    
    Set eSheet = Nothing
    Set eBook = Nothing
    Set oExcel = Nothing
    DoEvents
    Application.StatusBar = ""
    MsgBox "Import Completed.", vbInformation
    Exit Sub
10:
    eBook.Close False
    oExcel.Quit
    Application.ScreenUpdating = True
    Set eSheet = Nothing
    Set eBook = Nothing
    Set oExcel = Nothing
    MsgBox Err.Description
End Sub


Private Function SelectFile(FileTypeName As String, FileType As String) As String
    
    Dim FD As FileDialog
    
    SelectFile = ""
    
    Set FD = Application.FileDialog(msoFileDialogFilePicker)
    With FD
        .Title = "Select " & FileTypeName & " file"
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add FileTypeName & " File", "*." & FileType
    End With
    If FD.Show = -1 Then
        SelectFile = FD.SelectedItems(1)
    End If

End Function

Private Function RangeValue(RangeName As String) As String

    Dim i As Long
    Dim RangeToFind As Range
    Dim str As String

    Err.Clear
    On Error Resume Next
    With eBook
        For i = 1 To .Sheets.Count
            str = .Sheets(i).Range(RangeName).Value
            If Err.Number = 0 Then
                RangeValue = str
                formatCell = .Sheets(i).Range(RangeName).NumberFormat

                Exit For
            Else
                Err.Clear
            End If
        Next i
    End With
    On Error GoTo 0
    Err.Clear
End Function