не срабатывает функция на первом листе книги

[sega1999]

Народ, может кто поможет... имеется файл в котором работает макрос на открытие файла. Макрос пробегает по всем листам книги и в некоторые ячейки первого столбца прописывает функцию которая должна прорисовать картинки на всех листах. Если лист только один - все нормально. Если листов два, то прорисовка происходит только на втором листе. Что может быть?

Приложил 2 файла в архиве:
Bar-Code-Err.xlsm - с ошибкой
Bar-Code-Good.xlsm - без ошибки

Excel 2007

[Aleksandr H.]

Может не стоило автопересчет отключать? Не вникал глубоко, просто добавил 2 изменения. Открылось с рисунками

Private Sub Workbook_Open()
    Dim wsheets As Sheets
    Dim wsheet As Worksheet
    Dim wsheet1 As Worksheet
    
    Set wsheet1 = ЭтаКнига.ActiveSheet
    
    ' Отключение авто-пересчета
    ' Application.Calculation = xlCalculationManual
    
    Set wsheets = ЭтаКнига.Worksheets
    UserForm1.Show
    Dim d_rng As Range
    Set d_rng = ActiveCell
    
    
    For Each wsheet In wsheets
        '    Set wsheet = ЭтаКнига.ActiveSheet
        wsheet.Activate
        Dim c_cell As String
        Dim n_row As Integer
        n_row = 1
        c_cell = "B" + CStr(n_row)
        Dim data_rng1 As Range
        Dim data_rng As Range
        Set data_rng = wsheet.Range(c_cell)
        Dim height As Integer
        height = data_rng.RowHeight
        Dim cf As String
        Dim i As Integer
        i = 0
        
        Dim shp_rng As Range
        
        
        
        Do
            If IsEmpty(data_rng.Value) Then Exit Do
            
            Set shp_rng = data_rng.Offset(0, 1)
            
            '    Range("A2").Select
            '    ActiveCell.FormulaR1C1 = "22223wfasdfdasfasfasf"
            c_cell = "A" + CStr(n_row)
            Set data_rng1 = wsheet.Range(c_cell)
            ' пересчет ячейки
            'data_rng1.Calculate
            data_rng1.Select
            
' ======================
            '''  If IsEmpty(data_rng1.Value) Then
            '''   data_rng1.Select
            
            cf = "=CreateBarcode(R[6]C[1])"
            '    cf = "=CreateBarcode(ПСТР(R[6]C[1];6;39))"
            data_rng1.FormulaR1C1 = cf
            
            '        ActiveCell.FormulaR1C1 = cf
            '''  End If
' ======================
            
            Set data_rng = data_rng.Offset(8, 0)
            n_row = n_row + 8
            DoEvents
            '    PauseTime = 1    ' Set duration.
            '    Start = Timer    ' Set start time.
            '    Do While Timer < Start + PauseTime
            '        DoEvents    ' Yield to other processes.
            '    Loop

' ======================
            wsheet.Calculate '<<<<<<<<<<<<<<
' ======================
        Loop
    Next
    '   включение авто перечета
    ' Application.Calculation = xlCalculationAutomatic
    wsheet1.Activate
    d_rng.Select
    
    Unload UserForm1
End Sub

[sega1999]

тоже самое.

Кстати, если из ячеек с ошибкой убрать данные и запустить макрос , то все прорисуется нормально.
Но заставлять пользователя это делать нельзя.

[Aleksandr H.]

Сообщение от sega1999

тоже самое.

посмотрел ваш файл. Внесена только одна с моих правок.
Удачи в поиску решения.

[sega1999]

Извиняюсь, и второе Ваше изменение внес.
тоже самое.
Правда если после открытия запустить макрос через редактор, то срабатывает.

может файл битый изначально запускается...

[Aleksandr H.]

Попробуйте такой вариант еще