Рисование в EXCEL

[Alec]

И снова - здравствуйте!
Кто-нибудь сталкивался с необходимостью программного создания большого количества графических объектов(Shape) в EXCEL?
Есть ли какие-нибудь хитрости, позволяющие ускорить процесс...
800 объектов (а это тестовый пример, усредненный, предполагается больше) создаются в течение 3-х минут, а это как-то напрягает...(XP SP3, минимум оформления, Office XP, notebook proc Cel 2400, RAM 1 GB , но вопрос более универсальный)
Или как вариант - чем на это время занять пользователя?
.
PS. Варианты со сменой компьютера на более быстродействующий прошу не предлагать

[Димитрий]

Я не представляю зачем в Excel'е столько графических объектов. Графика не его специальность.
Вывод такой: Или уменьшить количество, или взять более подходящее приложение для работы с графикой.))

[Alec]

... или взять более подходящее приложение для работы с графикой.))

Взять более подходящее приложение и распостранять его вместе с файлами... С EXCEL проще - при распространении не надо ничего лишнего, в том числе знаний пользователей.
А с количеством EXCEL справляется довольно-таки неплохо, когда работаешь "ручками"...Только вот "ручками" как-то надоело уже...
Поэтому одно из ключевых слов в вопросе - "EXCEL"!

[Денис]

вариант - чем на это время занять пользователя?

Пожалуй только это, раз так. Подключи progressbar и показывай процент загрузки.

[KL]

Alec,
А ты не хочешь начать с публикации кода, рисующего 800 автоформ в теч. 3-х мин. Самое очевидное решение - это попытка оптимизации кода. А указанное тобой время уж очень напрягает. След. код у меня на VPC (Intel Core 2 Duo 1.6, MHz 512Mb памяти, Win XP SP3, Office 2003 SP3) затрачивает 132 миллисек.

Код: Выделить всё

Sub test()
    Dim t As Double, i As Long
    t = Timer
    Application.ScreenUpdating = False
    For i = 1 To 800
        Sheet1.Shapes.AddShape msoShapeOval, 10, 110 * i, 100, 100
    Next i
    Application.ScreenUpdating = True
    MsgBox Timer - t
End Sub

[Alec]

Вот именно этим я все это время и занимался, оптимизацией кода, поэтому той, старой долгой версии, уже не существет.
KL, а попробуй TextBox'ы, с заданием практически всех свойств, включая шрифты, цвета, размеры полей и проч. Тут-то как раз и были тормоза.
А вот за Application.ScreenUpdating - отдельно спасибо!

[KL]

Вот именно этим я все это время и занимался, оптимизацией кода, поэтому той, старой долгой версии, уже не существет.
KL, а попробуй TextBox'ы, с заданием практически всех свойств, включая шрифты, цвета, размеры полей и проч. Тут-то как раз и были тормоза.
А вот за Application.ScreenUpdating - отдельно спасибо!

Дык ты ж наверное все свойства через Select устанавливаешь, но вообще я не ясновидящий, а писать от балды - лень. Т.ч. вешай код и будем посмотреть

[Alec]

Я передаю из программы на VB6 описания объектов в процедуру AddShape, которая их и рисует.
Ниже - пока тот вариант, который у меня получился в попытках оптимизации
Это - в книге (при открытии она создает новую, в первом листе которой и рисует):

Код: Выделить всё

Public Enum AP_ShapeTypes
  AP_ShapeType_None = 0
  AP_ShapeType_Line = 1
  AP_ShapeType_Rectangle = 2
  AP_ShapeType_Oval = 3
  AP_ShapeType_TextBox = 4
End Enum

Public Sub AddShape(ST As AP_ShapeTypes, _
                    Left As Single, Top As Single, Width As Single, Height As Single, _
                    Name As String, _
                    LFC As Long, LFW As Single, LFT As Boolean, _
                    FFC As Long, FFT As Boolean, _
                    Text As String, _
                    TFC As Long, TFN As String, TFS As Single, TFB As Boolean, TFI As Boolean)
  Dim Shape As Shape
  With Workbooks(2).Sheets(1)
   With .Shapes
    Select Case ST
      Case AP_ShapeType_Line
        Set Shape = .AddLine(Left, Top, Left + Width, Top + Height)
      Case AP_ShapeType_Rectangle
        Set Shape = .AddShape(1, Left, Top, Width, Height)
      Case AP_ShapeType_TextBox
        Set Shape = .AddTextBox(1, Left, Top, Width, Height)
      Case Else
    End Select
    If Not Shape Is Nothing Then
       With Shape
       .Visible = False
         .Name = Name
         With .Line
           .ForeColor.RGB = LFC
           .Weight = LFW
           If LFT Then
             .Transparency = 1
           Else
             .Transparency = 0
           End If
         End With
         With .Fill
           .ForeColor.RGB = FFC
           If FFT Then
             .Transparency = 1
           Else
             .Transparency = 0
           End If
         End With
         If ST <> AP_ShapeType_Line Then
           With .TextFrame
             .AutoMargins = False
             .MarginLeft = 0#
             .MarginTop = 0#
             .MarginRight = 0#
             .MarginBottom = 0#
             .HorizontalAlignment = &HFFFFEFF4
             .VerticalAlignment = &HFFFFEFF4
             With .Characters
               With .Font
                 .Color = TFC
                 .Name = TFN
                 .Size = TFS
                 .Bold = TFB
                 .Italic = TFI
               End With
               .Text = Text
             End With
           End With
         End If
        .Visible = True
       End With
    End If
  End With
End With
End Sub


Из программы вызывется так:

Код: Выделить всё

Set XLS_App = CreateObject("EXCEL.Application")
With XLS_App
    Set XLS_WB = .Workbooks.Open(App.Path & "\Shapes.xls")
   With XLS_WB
   
  For Each MyShape in MyShapes

'задаю значения переменных, все переменные объявлены с соответствующим типом
'..........
'передаю их в открытый лист
  .Run "Shapes.xls!AddShape", ST, _
                       Left, Top, Width, Height, _
                       Name, _
                       LFC, Weight, LFT, _
                       FFC, FFT, _
                       T, _
                       TFC, TFN, TFS, TFB, TFI
  Next MyShape
  XLS_WB.Close
  .Visible=True
End With



Такая конструкция выполняется 31 сек (без учета времени создания объекта Excel, только цикл)
При закомменчивании строки с .Run цикл прогоняется за 1,5 сек

[KL]

Пожалуй, при таком кол-ве бифуркаций (IF и Select Case) кол-во операций возрастает в разы по сравнению с 800 операциями создания самих автоформ. Т.ч., пожалуй, время 31 сек. терпимое. Хотя, возможно, ScreenUpdating=False даст некоторое ускорение. Еще идеи:
1) А что если все проверки совершать в VB, а не VBA, т.е. еще до передачи параметров в процедуру AddShape?
2) А если попробовать все сделать ранним привязыванием (Early Binding) прямо из VB, а не ссылаться на процедуру в книге?

[Alec]

возможно, ScreenUpdating=False даст некоторое ускорение

Попробовал - пару секунд дает, но не уверен, что это не погрешность измерений, решил все-же оставить

1) А что если все проверки совершать в VB, а не VBA, т.е. еще до передачи параметров в процедуру AddShape?

От Select Case избавиться можно, только разделив процедуру на несколько. И не думаю, что что-то даст, тип проверяемых данных целый. Вынес Ifы в VB, существенной разницы не заметил.

2) А если попробовать все сделать ранним привязыванием (Early Binding) прямо из VB, а не ссылаться на процедуру в книге?

С этого и начинал, что в итоге ужаснулся (как раз те пресловутые 3 мин) и нашел Run.
Но! Сделав тип XLS_App и XSL_Shape непосредственно EXCEL.Application и EXCEL.Shape (не забыв поставить галочку на Excel в References), ранее были просто object, получил еще устойчивые 6 сек уменьшения!
Пока имею в среднем 19 сек. (до изменений было 26, я себе тестовый пример сделал)
Сейчас думаю, может вместо Shapes.AddXXX использовать Duplicate... Попробую...

[tyomitch]

У меня на прошлой работе именно таким было одно из первых заданий
Пошёл по тому же пути: перенёс всю рисовалку в VB6, скомпилировал (в ActiveX DLL, чтобы не мутили воду межпроцессные вызовы), и посмотрел профайлером, где съедается всё время. Потом узко-прицельно оптимизировал.
Кажется, прооптимизировал с 10 мин до одной. Сколько конкретно шейпов было там, не вспомню.

[Alec]

Попробовал Duplicate - никакой разницы не увидел. Но думаю будет скорее всего дольше - свойства то все равно устанавливать придется... Так что остановлюсь пока на достигнутом.
Всем спасибо.