Loop through named ranges in different files and create jpgs in VBA Excel

Question

I am trying to loop through named ranges in VBA Excel in order to create jpgs/pics from tables that I have created in particular cells. The Code is supposed not only to loop through named ranges in one single workbook but also in multiple workbooks which are defined path-wise in the "Main" Excel Worksheet.

I have already named the respective ranges individually in the respective workbooks so that they appear in the name manager in Excel.

Public Sub Charts_to_JPG()

    '''''''''''''''''''
    '''Deklarationen'''
    '''''''''''''''''''

    Dim i As Integer
    Dim j As Integer
    Dim lastRowFiles As Integer

    Dim lWidth As Long, lHeight As Long

    Dim wb As Workbook
    Dim sht As Worksheet
    Dim nm As Name
    Dim rng As Range

    Dim chrt As ChartObject
    Dim objChrt As Chart

    Dim strFile As String
    Dim Filename As String

    ' Einige optische Feinheiten
    With Application
        .Cursor = xlWait
        .DisplayStatusBar = True
        .StatusBar = "Update der Excel-Dateien wird ausgeführt ..."
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
        .AskToUpdateLinks = False
        .Calculation = xlCalculationManual
        .AutomationSecurity = msoAutomationSecurityForceDisable
    End With

    '''Erst mal alle anderen Workbooks schließen
    For Each wb In Workbooks
        If Not wb.Name = ThisWorkbook.Name Then
            wb.Close SaveChanges:=True
        End If
    Next wb

    lastRowFiles = CInt(WorksheetFunction.CountA(Worksheets("Main").Range("B6:B100000")))

    For i = 1 To lastRowFiles

        Workbooks.Open CStr(ThisWorkbook.Sheets("Main").Cells(5 + i, 2).Value)
        DoEvents
        Set wb = ActiveWorkbook

        Filename = CStr(CreateObject("Scripting.FileSystemObject").GetBaseName(wb.Name))


            For j = 1 To wb.Names.Count

                 Select Case CInt(wb.Names.Count)

                    Case 0

                        Exit For

                    Case Else

                     If Replace(CStr(wb.Names(j).RefersTo), "=", "") = "#NAME?" Then

                     Else

                         Set sht = Sheets(wb.Names(j).Application.ActiveSheet.Name)

                         Set rng = sht.Range(Replace(CStr(wb.Names(j).RefersTo), "=", ""))

                             rng.CopyPicture xlScreen, xlPicture
                             lWidth = rng.Width
                             lHeight = rng.Height

                             Set chrt = sht.ChartObjects.Add(Left:=0, Top:=0, Width:=lWidth, Height:=lHeight)

                             strFile = CStr(ThisWorkbook.Sheets("Main").Cells(5 + i, 4).Value) & "\" & Filename & "_" & CStr(wb.Names(j).Name) & ".jpg"

                             chrt.Activate
                             With chrt.Chart
                                  .Paste
                                  .Export strFile, FilterName:="JPG"
                             End With
                             DoEvents

                             chrt.Delete

                     End If

                End Select


            Next j

            wb.Close True

    Next i

    With Application
        .StatusBar = ""
        .DisplayStatusBar = False
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
        .AskToUpdateLinks = True
        .Cursor = xlDefault
        .AutomationSecurity = msoAutomationSecurityLow
    End With 

End Sub

The Problem is that I get a run time error '1004' with Set rng = sht.Range(Replace(CStr(wb.Names(j).RefersTo), "=", "")) saying that the 'method Range failed for object worksheet' in that particular line of code.

Any idea how to fix this or to write it differently? Any help would be greatly appreciated since I cannot see the forest for the trees anymore. Thank you very much in advance!

Also note, = "#NAME?" is locale-sensitive - that code won't work on a non-English computer. — Mathieu Guindon
Thanks Mathieu. But your first proposal doesn't work either. I receive a run time error '1004' (application or object related error). <Code> = "#NAME?" </Code> does not produce any errors. Any other ideas what could be wrong with my code? — AnDr
Without seeing what the names are referring to, hard to tell. Looks like the names aren't referring to valid ranges. — Mathieu Guindon

AnDr AnDr · Accepted Answer · 2019-08-29T09:38:13

Ok. I have finally figured out, what the problem was. The worksheet object has created the error because Excel uses all named ranges including so-called "invisible" ones, meaning old deleted ones. What you have to add is simply a piece of code namely If nm.visible = True Then etc. so that only visible named ranges are considered which are actually defined in the Names Manager.

Loop through named ranges in different files and create jpgs in VBA Excel

1 Answers