Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Как удалить VBA графические объекты? / 19 сообщений из 19, страница 1 из 1
23.10.2006, 13:59
    #34073947
talgat
talgat
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как удалить VBA графические объекты?
Excel
Красивый (на мой вгляд) графический прогресс-бар. Не получается его программно удалять по завершении процесса. Макрорекордер не помог.
Подскажите как его программно удалять.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
23.10.2006, 14:23
    #34074059
talgat
talgat
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как удалить VBA графические объекты?
Private Sub CommandButton1_Click()
' рисуется прямоугольникActiveSheet.Shapes.AddShape(msoShapeRectangle, 96.75, 90#, 408#, 19.5).Select
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
' тестовый цикл
For x = 100 To 500 Step 3
Shapes.AddLine(x, 100, x + 2, 100).Select
Selection.ShapeRange.Line.ForeColor.SchemeColor = 12
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.Weight = 12#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.Style = msoLineSingle
Cells(1, 1).Activate
Next x


End Sub

' Как все это стереть?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
23.10.2006, 15:13
    #34074256
SirFisher
SirFisher
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как удалить VBA графические объекты?
talgat
Извини, пожалуйста, я немножко переписал твой макрос:
Код: plaintext
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.
Sub Макрос7()
'
' Макрос7 Макрос
' Макрос записан 20.10.2006 (DTK)
'

'
 
 ActiveSheet.Shapes.AddShape(msoShapeRectangle,  96 . 75 ,  90 #,  408 #,  19 . 5 ).Select
        With Selection.ShapeRange.Fill
            .Visible = msoFalse
            .Transparency =  0 #
        End With
        With Selection.ShapeRange.Line
            .Weight =  0 . 75 
            .DashStyle = msoLineSolid
            .Style = msoLineSingle
            .Transparency =  0 #
            .Visible = msoTrue
            .ForeColor.SchemeColor =  64 
            .BackColor.RGB = RGB( 255 ,  255 ,  255 )
        End With
    For x =  100  To  500  Step  3 
        ActiveSheet.Shapes.AddLine(x,  100 , x +  2 ,  100 ).Select
            With Selection.ShapeRange.Line
                .ForeColor.SchemeColor =  12 
                .Visible = msoTrue
                .Weight =  12 #
                .Visible = msoTrue
                .Style = msoLineSingle
            End With
        Cells( 1 ,  1 ).Activate
    Next x
End Sub

Для удаления графических объектов использовал следующий код (кстати, кнопку он тоже удаляет)
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
Sub Макрос8()
'
' Макрос8 Макрос
 Dim n As Variant, i As Integer
 On Error Resume Next
        n = ActiveSheet.Shapes.Count
        i =  0 
        For i = i +  1  To n
            ActiveSheet.Shapes(i).Select
            Selection.Delete
        Next i
End Sub

У кода есть недостаток: за один заход он не убирает все графические объекты.
Надеюсь, коллеги не сочтут за труд и в случае необходимости поправят.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
23.10.2006, 15:21
    #34074297
talgat
talgat
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как удалить VBA графические объекты?
To SirFisher:
Кнопку удаляет. А линии только частично. И прямоугольник остается.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
23.10.2006, 15:24
    #34074317
talgat
talgat
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как удалить VBA графические объекты?
Конструкция i = i + 1 To n совсем не понятна.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
23.10.2006, 15:28
    #34074335
SirFisher
SirFisher
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как удалить VBA графические объекты?
talgatTo SirFisher:
Кнопку удаляет. А линии только частично. И прямоугольник остается.
Выше написал, что макрос удаляет кнопку и еще сырой. Для полного удаления графических объектов приходится несколько раз вызывать Макрос8.

talgatКонструкция i = i + 1 To n совсем не понятна.
Пошаговое выделение объекта, i после каждого цикла приращивается на 1.
Моё предложение не панацея и требует доработки, чем сейчас и занят. Также буду рад, если Вы подскажете полноценное решение.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
23.10.2006, 15:43
    #34074397
talgat
talgat
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как удалить VBA графические объекты?
On Error Resume Next
n = ActiveSheet.Shapes.Count
MsgBox (n) For i = 500 To 520
ActiveSheet.Shapes(i).Select
Selection.Delete
Next i
Как ни странно n принимает разные значения. От чего зависит значение я не пойму.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
23.10.2006, 15:49
    #34074419
SirFisher
SirFisher
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как удалить VBA графические объекты?
talgatOn Error Resume Next
n = ActiveSheet.Shapes.Count
MsgBox (n) For i = 500 To 520
ActiveSheet.Shapes(i).Select
Selection.Delete
Next i
Как ни странно n принимает разные значения. От чего зависит значение я не пойму.
Такую штуковину уже сделал и тоже пока не могу ума дать, почему за 1 проход не удаляет все графические объекты.
Кроме того, можно еще упростить код:
Код: plaintext
1.
ActiveSheet.Shapes(i).Select
Selection.Delete
записав как
Код: plaintext
ActiveSheet.Shapes(i).Delete

P.S. Кстати, Вы правы, инструкция i=i+1 не нужна.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
23.10.2006, 16:06
    #34074507
SirFisher
SirFisher
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как удалить VBA графические объекты?
talgat
Всё работает.
Код: plaintext
1.
2.
3.
4.
5.
6.
Sub Макрос99()
'
' Макрос99 Макрос
  ActiveSheet.Shapes.SelectAll
  Selection.Delete
End Sub
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
23.10.2006, 16:10
    #34074521
talgat
talgat
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как удалить VBA графические объекты?
SirFisher talgat
Всё работает.
Код: plaintext
1.
2.
3.
4.
5.
6.
Sub Макрос99()
'
' Макрос99 Макрос
  ActiveSheet.Shapes.SelectAll
  Selection.Delete
End Sub


Спасибо!
Как нашли решение?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
23.10.2006, 16:14
    #34074537
talgat
talgat
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как удалить VBA графические объекты?
Плохо что кнопка удаляется.
Она нужна для запуска процесса.
Но это уже другой вопрос. Спасибо!
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
23.10.2006, 16:14
    #34074539
SvIva
SvIva
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как удалить VBA графические объекты?
SirFisher
Так вы удалите нужные кнопки, только для линий:
Код: plaintext
1.
2.
3.
4.
5.
6.
For i =  1  To ActiveSheet.Shapes.Count
   If InStr( 1 , ActiveSheet.Shapes(i).Name, "Line") >  0  Then
    ActiveSheet.Shapes(i).Select
    Selection.Delete
    If i >  1  Then i = i -  1 
   End If
Next
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
23.10.2006, 16:15
    #34074543
SirFisher
SirFisher
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как удалить VBA графические объекты?
talgat
Немножко побродил в хелпе VBA по семейству Shape.
Прошу меня извинить, у нас уж за полночь. До свидания.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
23.10.2006, 16:23
    #34074587
talgat
talgat
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как удалить VBA графические объекты?
SvIva SirFisher
Так вы удалите нужные кнопки, только для линий:
Код: plaintext
1.
2.
3.
4.
5.
6.
For i =  1  To ActiveSheet.Shapes.Count
   If InStr( 1 , ActiveSheet.Shapes(i).Name, "Line") >  0  Then
    ActiveSheet.Shapes(i).Select
    Selection.Delete
    If i >  1  Then i = i -  1 
   End If
Next

If InStr(1, ActiveSheet.Shapes(i).Name, "Line") > 0 Then
Дает ошибку. Хотя до ошибки линии удаляются, а прямоугольник нет.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
23.10.2006, 16:40
    #34074665
SvIva
SvIva
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как удалить VBA графические объекты?
Естественно, дает ошибку, здесь показан принцип и нет проверки на конец коллекции Shape.
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
For i =  1  To ActiveSheet.Shapes.Count
   If InStr( 1 , ActiveSheet.Shapes(i).Name, "Line") >  0  Then
    ActiveSheet.Shapes(i).Select
    Selection.Delete
    If i >  1  Then i = i -  1 
'    Вот эта проверка
    If i = ActiveSheet.Shapes.Count Then Exit For
End If
А для прямоугологика нужна доп.проверка на имя "Rectangle".
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
23.10.2006, 16:44
    #34074687
talgat
talgat
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как удалить VBA графические объекты?
SvIvaЕстественно, дает ошибку, здесь показан принцип и нет проверки на конец коллекции Shape.
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
For i =  1  To ActiveSheet.Shapes.Count
   If InStr( 1 , ActiveSheet.Shapes(i).Name, "Line") >  0  Then
    ActiveSheet.Shapes(i).Select
    Selection.Delete
    If i >  1  Then i = i -  1 
'    Вот эта проверка
    If i = ActiveSheet.Shapes.Count Then Exit For
End If
А для прямоугологика нужна доп.проверка на имя "Rectangle".
СпасибА
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
23.10.2006, 17:08
    #34074776
talgat
talgat
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как удалить VBA графические объекты?
Получилось прикольно. При переходе с листа на лист срабатывает прогресс-бар.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
24.10.2006, 08:48
    #34075750
SvIva
SvIva
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как удалить VBA графические объекты?
Так будет красивее и быстрее работать (утро вечера мудреннее !).
Код: plaintext
1.
2.
3.
4.
5.
Sub test1()
Dim myShp As Shape
For Each myShp In ActiveSheet.Shapes
   If Left(myShp.Name,  4 ) = "Line" Or Left(myShp.Name,  4 ) = "Rect" Then myShp.Delete
Next
End Sub
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Период между сообщениями больше года.
19.11.2012, 09:23
    #38043640
Joann
Joann
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Как удалить VBA графические объекты?
Все это ерунда, а вот действительно важные вопросы здесь как раз и не затрагиваются...
Раз уж это прогрессбар, то естественно он должен доводить до пользователя состояние выполнения процесса по времени, но вот как раз время - то исполнения самого прогресс-бара непостоянно.
Попробуйте запустите его раз 10-15 подряд (даже на очень неслабой машине с i5) - картина становится оооочеень забавной. И даже элементарный процесс, который отображается (10м или 15м) прогрессбаром затянется на часы уже по вине самого этого прогрессбара.
Далее, почему уже созданные объекты так долго удаляются (и программно и вручную)?
Кто знает, в чем тут подвох?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Как удалить VBA графические объекты? / 19 сообщений из 19, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
созд. / загр.: 455ms
Закрыть
start [/forum/topic.php?fid=61&tablet=1&tid=2175206]:
 0ms
get settings:
 9ms
get forum list:
 13ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 29ms
get topic data:
 12ms
get forum data:
 3ms
get page messages:
 54ms
get tp. blocked users:
 2ms
others: 325ms
total:  455ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]