Добрый день!
Ситуация такая: есть рабочая книга Excel 2007, в которой в определенном столбце хранятся коды товаров. На локальном диске лежит папка с изображениями каждого товара, если код товара оncутствует в названии картинки, то вместо нее вставляется картинка "Нет фото".
Проблема: отчет отрабатывает очень долго, 6-8 минут. Есть список кодов > 3 000 товаров, для каждого товара вставляется картинка. Изображение само по себе небольшое, уменьшать уже некуда.
Вес изображения: 1,5-2 Кб
Размер: 61х39 пикселей.
Отключил перерисовки объектов на экране, чтобы ничего не мигало, отключил вычисления формул и прочее. Время отработки немного уменьшилось, НО, по мере вставки картинок, скорость все меньше и меньше. Мне кажется, проблема в том, что я обращаюсь к каждой ячейке в рабочей книге используя цикл While. Просто обычный перебор кодов и 2 условия на вставку. Как можно существенно ускорить процесс вставки изображений? Может нужно каким-то образом использовать массивы?
Код на VBA очень простой. Один цикл While и два условия.
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
Sub OnRefresh()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Application.DisplayStatusBar = False
Application.DisplayAlerts = False
Dim rgResult As Range
Set rgResult = Range("A1:IV65536").Find("material", , xlValues)
If rgResult Is Nothing Then
MsgBox "material not found"
End If
Dim f As Shape
For Each f In ActiveSheet.Shapes
If Not Intersect(Range(f.BottomRightCell.Address), Range("L16:L65536")) Is Nothing Then
f.Delete
End If
Next
i = 1
var01 = Range(rgResult.Address).Offset(i, 0)
While var01 <> ""
If Dir("D:\_foto\" & var01 & ".JPG") = "" Then
With ActiveSheet.Pictures.Insert("D:\_foto\nothing.JPG")
.Top = Range(rgResult.Address).Offset(i, 6).Top
.Left = Range(rgResult.Address).Offset(i, 6).Left
End With
Rows(rgResult.Row + i).Select
Selection.RowHeight = 50
Else
With ActiveSheet.Pictures.Insert("D:\_foto\" & var01 & ".JPG")
.Top = Range(rgResult.Address).Offset(i, 6).Top
.Left = Range(rgResult.Address).Offset(i, 6).Left
End With
Rows(rgResult.Row + i).Select
Selection.RowHeight = 50
End If
i = i + 1
var01 = Range(rgResult.Address).Offset(i, 0)
Wend
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.DisplayStatusBar = True
Application.DisplayAlerts = True
End Sub
