Увеличить-уменьшить ячейку с рисунком Excel 2003

[vfv]

При клике на рисунок,увеличиваются размеры ячейки вместе с рисунком.При повторном клике на рисунок, размеры ячейки вместе с рисунком возвращаются в исходное состояние.Всё работает.Однако не нравится, что при кликах по рисунку, рисунок как то мелькает.Подскажите как можно это устранить.

[slan]

вместо всех ваших вот эту одну:

Sub click()
Dim s$
s = Application.Caller
With ActiveSheet.Shapes(s).TopLeftCell
.EntireRow.RowHeight = IIf(.Height < 300, 340, 60)
.EntireColumn.ColumnWidth = IIf(.Width < 80, 90, 8)
Application.Goto .Cells, 1
End With
End Sub

[vfv]

Макрос у вас отличный. Однако нужно ещё ,чтобы при первом клике по выбранной картинке (для её увеличения),все остальные строки с картинками, кроме строки с увеличенной картинкой, скрывались.При втором клике ,чтобы всё строки и размер всех картинок восстановилось в первоначальное состояние.

[slan]

ну так это уже мелочи - доработка


могли бы и сами..


UsedRange.EntireRow.Hidden = True
.Hidden = False


в контексте моего макоса, конечно..

[vfv]

Уважаемый, "slan" !
Ваш макрос оказался для меня сложным.
Ни как не пойму куда в код вставить ваше дополнение.
Попробовал разные варианты,однако нарушается работа макроса.
Поможите?

[slan]

Sub click_()
 Dim s$, b As Boolean
 s = Application.Caller
 With ActiveSheet.Shapes(s).TopLeftCell
 b = .Width < 80
 ActiveSheet.UsedRange.EntireRow.Hidden = b
 .EntireRow.Hidden = Not b
 .EntireRow.RowHeight = IIf(b, 340, 60)
 .EntireColumn.ColumnWidth = IIf(b, 90, 8)
 Application.Goto .Cells, 1
 End With
 End Sub


Sub shonact()
Dim x
For Each x In ActiveSheet.Shapes
    If x.TopLeftCell.Column = 1 Then x.OnAction = "click_"
Next
End Sub

второй макрос - чтобы переназначить всем рисункам макрос на новый
рисунки должны быть в первом столбце листа, лист должен быть активным. макрос надо запустить один раз - сможете? без кнопки..?

[vfv]

Уважаемый, "slan" !
Испытал ваш доработанный макрос - работает идеально,так как я хотел.
Чтобы не было мельканий строк при работе макроса в начале кода я вставил строчку -Application.ScreenUpdating = False .Спасибо.Может подскажите ещё почему при клике на картинку с цветной нитью, сначало при нажатии на неё виден негатив, а при отпускании происходят небольшие мелькания до момента увеличения.Эту картинку я склеивал из трёх разных картинок.Это может из за того,что она больше весит.Устранимо ли это? Если нет и так хорошо.

[slan]

негатив - это спец эффект при нажатии, не знаю как его отключить

[vfv]

Уважаемый, "slan" ! Аппетит приходит во время еды.Под себя я код немного изменил:

Sub click_()
 Application.ScreenUpdating = False
 Dim s$, b As Boolean
 s = Application.Caller
 With ActiveSheet.Shapes(s).TopLeftCell
 b = .Width < 80
 ActiveSheet.UsedRange.EntireRow.Hidden = b
 .EntireRow.Hidden = Not b
 .EntireRow.RowHeight = IIf(b, 340, 60)
 
 ActiveWindow.SmallScroll Down:=-1
 
 .EntireColumn.ColumnWidth = IIf(b, 90, 8)
 End With
 End Sub

Картинка возвращается в то же место на экране,откуда кликнули.Однако если верхние картинки были передвинуты - скрыты колёсиком мыши, то после уменьшения кликнутая картинка смещается,а все скрытые отображаются.Можно ли изменить макрос,чтобы картинка возвращалась в первоночальное положение,а скрытые так и оставались скрытыми?

[Zay177]

Помогите пожалуйста!!! не могу разобраться как в exсel сделать сумму прописью, напишите как сделать это проще.
Заранее спасибо!