Как исправить: ошибки генерации 2D-кода и экспорта изображений во время цикла

Question

У меня есть файл Excel, который используется для создания таблиц настройки для переключения машин.Лист настройки содержит 7 кодов двумерных матриц (для этого я использую дополнение TEC-IT), а также другую информацию, вычисляемую функциями Excel.Пользователь должен просто выбрать несколько номеров деталей (PN) на SheetB, поместив «x» в столбец «Печать», а затем запустить макрос.Макрос выполняет следующие действия: 1. выполняет поиск «x» на SheetB 2. в строке, где найден x, информация PN принимается и переносится на SheetA в объединенные ячейки 3. коды двумерной матрицы и другая информацияобновляется с использованием нового PN (сделано с помощью функций Excel) 4. форма листа настройки с кодами и информацией копируется и вставляется как изображение в вставленный объект диаграммы 5. объект диаграммы с вставленным изображением экспортируется в файл .png, затемудалено 6. этот цикл повторяется для каждого "x"

У меня возникли 2 проблемы: Проблема 1: чтобы убедиться, что 2D-коды были обновлены с новыми данными, макрос изменяет ширину и высоту кодасначала объекты + направление, затем - направление на такое же количество (более надежного способа я не нашел, чтобы убедиться, что обновление произойдет).Но если число циклов велико (пока я бы сказал, что безопасное число циклов составляет около 30-40), тогда объекты 2D-кода начинают уменьшаться.То есть номер цикла равен 100 или более, тогда объекты 2D-кода уменьшаются до 25% от исходного размера.Это происходит на каждом компьютере, на котором я тестировал.

Проблема 2: Во время некоторых циклов пустая белая страница экспортируется как .png.Ничего не включено с листа (без текста, без кода, без форматирования, ничего).Это происходит случайным образом и на нескольких компьютерах с одинаковой версией Excel.

Вот код:

Sub main()
Dim poszlop As Double
Dim ucikksor As Double
Dim aktcikksor As Double
'Dim sFilePath As String

'Defining constants

Const cikkoszlop = 2 ' define column containing the PN on SheetB
Const cikksor = 11 ' define row number containing the first PN on SheetB
Const pcode = "Product-Stations-Codes" 'name of the excel sheet containing all the source data for each PN
Const rustsheet = "Setup sheet" 'name of the excel sheet containing the setup-sheet form (SheetA)
Const psor = 9 ' define row number containing the "Print" text on SheetB
Const rblatt_cikksor = 5 ' row number of the cell containing the PN on SheetA
Const rblatt_cikkoszl = 3 ' column number of the cell containing the PN on SheetA

' delete any .png files in destination folder for the pictures
Call mappaurit

'1. step: find the column designating the "Print" option
Worksheets(pcode).Activate

poszlop = 1

While Cells(psor, poszlop) <> "Print"
poszlop = poszlop + 1

Wend

'2. step: find the last row containing a PN (basically the last row of the datatable
ucikksor = cikksor
While Cells(ucikksor, cikkoszlop) <> ""
    ucikksor = ucikksor + 1
Wend
ucikksor = ucikksor - 1
aktcikksor = cikksor

'3 step: find rows containing an "x" at the "Print" column and do the picture exporting

While Worksheets(pcode).Cells(aktcikksor, cikkoszlop) <> ""
    If Worksheets(pcode).Cells(aktcikksor, poszlop) = "" Then GoTo vege
        Worksheets(rustsheet).Cells(rblatt_cikksor, rblatt_cikkoszl) = Worksheets(pcode).Cells(aktcikksor, cikkoszlop)

        'Change the size of the 2D matrix codes to make them update
        Worksheets(rustsheet).Activate

        Worksheets(rustsheet).TBarCode102.Width = Worksheets(rustsheet).TBarCode102.Width + 1
        Worksheets(rustsheet).TBarCode102.Width = Worksheets(rustsheet).TBarCode102.Width - 1

        Worksheets(rustsheet).TBarCode103.Width = Worksheets(rustsheet).TBarCode103.Width + 1
        Worksheets(rustsheet).TBarCode103.Width = Worksheets(rustsheet).TBarCode103.Width - 1

        Worksheets(rustsheet).TBarCode104.Width = Worksheets(rustsheet).TBarCode104.Width + 1
        Worksheets(rustsheet).TBarCode104.Width = Worksheets(rustsheet).TBarCode104.Width - 1

        Worksheets(rustsheet).TBarCode105.Width = Worksheets(rustsheet).TBarCode105.Width + 1
        Worksheets(rustsheet).TBarCode105.Width = Worksheets(rustsheet).TBarCode105.Width - 1

        Worksheets(rustsheet).TBarCode106.Width = Worksheets(rustsheet).TBarCode106.Width + 1
        Worksheets(rustsheet).TBarCode106.Width = Worksheets(rustsheet).TBarCode106.Width - 1

        Worksheets(rustsheet).TBarCode107.Width = Worksheets(rustsheet).TBarCode107.Width + 1
        Worksheets(rustsheet).TBarCode107.Width = Worksheets(rustsheet).TBarCode107.Width - 1

        Worksheets(rustsheet).TBarCode108.Width = Worksheets(rustsheet).TBarCode108.Width + 1
        Worksheets(rustsheet).TBarCode108.Width = Worksheets(rustsheet).TBarCode108.Width - 1

        'do the picture exporting
        Call ExportImage

vege:
aktcikksor = aktcikksor + 1
Wend

'open the destination folder for the pictures
Call openpictfold

End Sub

Sub ExportImage()
'Export as picture

Dim sheet, zoom_coef, area, chartobj
Dim sFilePath As String
Dim sView As String

'Captures current window view
sView = ActiveWindow.View

'Sets the current view to normal so there are no "Page X" overlays on the image
ActiveWindow.View = xlNormalView

'Temporarily disable screen updating
Application.ScreenUpdating = False

Set sheet = ActiveWorkbook.Worksheets("Setup sheet")

sheet.Unprotect ("password")

'##################
'Łukasz : Save to  workbook directory
'Asking for filename insted of ActiveSheet.Name is also good idea, without file extension
Dim FileID As String, LineID As String
FileID = sheet.Range("C5")
LineID = sheet.Range("AR14")
sFilePath = "G:\IE\Gyartosorok\AMC1\NETOROLDKI_R230-2_setupsheetpicsformacro" & "\" & LineID & "_" & FileID & ".png"

ActiveSheet.PageSetup.PrintArea = sheet.Range("A1:AL51").Address

'Export print area as correctly scaled PNG image, courtasy of Winand
'Łukasz: zoom_coef can be constant = 0 to 5 can work too, but save is 0 to 4
'Befolyásoló érték a zoom_coef, próbálgatással kell megtalálni a megfelelőt
zoom_coef = 2 '100 / sheet.Parent.Windows(1).Zoom
'#############
' Set the area for the picture export
Set area = sheet.Range(sheet.PageSetup.PrintArea)
area.CopyPicture xlPrinter, xlPicture

'insert chart object then insert the copied area as picture into the chart object and export it as picture
Set chartobj = sheet.ChartObjects.Add(0, 0, area.Width * zoom_coef, area.Height * zoom_coef)

With chartobj
.Select
.Parent.Activate
With .Chart
.Paste
.Export sFilePath, "png"

End With
.Delete
End With

'Returns to the previous view
ActiveWindow.View = sView

'Re-enables screen updating
Application.ScreenUpdating = True

sheet.Protect "password", True, True


End Sub