Объекты с картинками

Программирование на Visual Basic for Applications
Vitaly1
Брехман
Брехман
 
Сообщения: 1578
Зарегистрирован: 30.12.2002 (Пн) 16:35
Откуда: Russia, Mosсow

Объекты с картинками

Сообщение Vitaly1 » 07.04.2004 (Ср) 17:17

На листе Excel через меню вставка из файла вставлены 15 маленьких картинок. каждому объекту с картинкой назначен макрос клика мыши.
Каждый объект через этот макрос передвигается по листу Excel. Если не "гасить" объекты с картинками, и вновь их не показывать, через некоторое время картинки в объектах исчезают, а потом выводится сообщение Не хватает памяти. Однако, если после передвижения объекта гасить объекты и вновь включать, все ок. Но происходип мелькания объектов при их передвижении. (смотрите мой проект логические игры - Мозайка-Пятнашки-Мозайка).
http://bbs.vbstreets.ru/viewtopic.php?t=4605&start=15

Я не понимаю, почему начинает "съедаться" память при передвижении объекта с картинкой? И почему, если объекты после передвижения скрыли, и отобразили вновь расход памяти не происходит.
Может как то можно подругому сделать, что бы не было мелькания объектов?

corgi
ToyMan
ToyMan
 
Сообщения: 1367
Зарегистрирован: 01.10.2002 (Вт) 9:59
Откуда: Россия, Москва

Сообщение corgi » 08.04.2004 (Чт) 15:01

а можно примерчик как работает и как нет :?:
Ничто так не ограничивает полёт мысли программиста, как компилятор

Vitaly1
Брехман
Брехман
 
Сообщения: 1578
Зарегистрирован: 30.12.2002 (Пн) 16:35
Откуда: Russia, Mosсow

Сообщение Vitaly1 » 09.04.2004 (Пт) 9:55

Код: Выделить всё
Public Sub Переставить(n1 As String, k)
s = Cells(k, 7).Value

If Cells(Range(s).Row + 1, Range(s).Column).Value <> "" And _
Cells(Range(s).Row - 1, Range(s).Column).Value <> "" And _
Cells(Range(s).Row, Range(s).Column + 1).Value <> "" And _
Cells(Range(s).Row, Range(s).Column - 1).Value <> "" Then
Exit Sub
End If
ActiveSheet.Unprotect
Cells(k, 7).Value = Cells(Cells(7, 1).Value, Cells(7, 2).Value).Address

ActiveSheet.Shapes(n1).Select
Selection.ShapeRange.Top = Cells(Cells(7, 1).Value, Cells(7, 2).Value).Top
Selection.ShapeRange.Left = Cells(Cells(7, 1).Value, Cells(7, 2).Value).Left
'ЕCЛИ ТУТ НЕ СКРЫВАТЬ
ActiveWorkbook.DisplayDrawingObjects = xlHide

Cells(Cells(7, 1).Value, Cells(7, 2).Value).Value = n1
Range(s).Value = ""

Cells(7, 1).Value = Range(s).Row
Cells(7, 2).Value = Range(s).Column
Cells(Cells(7, 1).Value, Cells(7, 2).Value).Select
'А ТУТ НЕ ПОКАЗЫВАТЬ, ТО ЧЕРЕЗ НЕКОТОРОЕ КОЛИЧЕСТВА
'ПЕРЕСТАВЛЕНИЙ ИСЧЕЗАЮТ КАРТИНКИ В ОБЪЕКТАХ, А ПОТОМ
'ПАМЯТИ НЕ ХВАТАЕТ
ActiveWorkbook.DisplayDrawingObjects = xlPlaceholders

ActiveSheet.Protect
End Sub

Private Sub Объект3_Щелкнуть()
Переставить "Object 3", 1
End Sub

Private Sub Объект4_Щелкнуть()
Переставить "Object 4", 2
End Sub

. . .


Вернуться в VBA

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 118

    TopList