Проблема с ProgressBar к конкретному макросу

Пользователь

Сообщений: 160 Регистрация: 22.12.2012

Мой ник без пробелов, но через тире @yandex.ru и будет моя почта!

03.03.2010 12:19:46

Уважаемые Господа,

Плохо разбираюсь в VBA и незнаю как добавить ProgressBar к макросу, код которого привожу ниже.

Макрос выполняет подмену гиперссылок, при изменении имени листа и нужен именно в таком виде как есть.

Хотелось бы чтоб по ходу выполнения макроса по центру экрана появлялась форма которая показывала бы состояние выполнения сего действа.

Я поискал на форуме похожие темы и их много, но применить к макросу неполучается.

Помогите пожалуйста, в идеале дайте файл с прогрессбаром и этим макросом и формой.

Sub МакросПодменыГиперов()

' Подмена

Range("C18").Select
Selection.Hyperlinks(1).SubAddress = "B154"
Range("C19").Select
Selection.Hyperlinks(1).SubAddress = "B191"
Range("C20").Select
Selection.Hyperlinks(1).SubAddress = "B228"
Range("C21").Select
Selection.Hyperlinks(1).SubAddress = "B265"
Range("C22").Select
Selection.Hyperlinks(1).SubAddress = "B302"
Range("C23").Select
Selection.Hyperlinks(1).SubAddress = "B339"
Range("C24").Select
Selection.Hyperlinks(1).SubAddress = "B376"
Range("C25").Select
Selection.Hyperlinks(1).SubAddress = "B413"
Range("C26").Select
Selection.Hyperlinks(1).SubAddress = "B450"
Range("C27").Select
Selection.Hyperlinks(1).SubAddress = "B487"
Range("C28").Select
Selection.Hyperlinks(1).SubAddress = "B524"
Range("C29").Select
Selection.Hyperlinks(1).SubAddress = "B561"
Range("C30").Select
Selection.Hyperlinks(1).SubAddress = "B598"
Range("C31").Select
Selection.Hyperlinks(1).SubAddress = "B635"
Range("C32").Select
Selection.Hyperlinks(1).SubAddress = "B672"
Range("C33").Select
Selection.Hyperlinks(1).SubAddress = "B709"
Range("C34").Select
Selection.Hyperlinks(1).SubAddress = "B746"
Range("C35").Select
Selection.Hyperlinks(1).SubAddress = "B783"

' Подмена основных

Range("B126:C127").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"B16", TextToDisplay:=" Перейти по ссылке… "
Selection.Font.Size = 11
Selection.Font.Underline = xlUnderlineStyleNone
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Selection.Font.Bold = True
Selection.Font.Size = 14

Range("A125:C128").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=15
Range("A162").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=36
Range("A199").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=39
Range("A236").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=39
Range("A273").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=39
Range("A310").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=33
Range("A347").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=39
Range("A384").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=33
Range("A421").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=36
Range("A458").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=36
Range("A495").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=36
Range("A532").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=39
Range("A569").Select
ActiveSheet.Paste
Range("B1").Select

End Sub

gaz-polutorka Пользователь Сообщений: 160 Регистрация: 22.12.2012 Мой ник без пробелов, но через тире @yandex.ru и будет моя почта!	#2 03.03.2010 12:28:57 Вот прилагаю форму, которую пытался прикрепить... Прикрепленные файлы post_105041.zip (1.2 КБ)

EducatedFool

Пользователь

Сообщений: 3695 Регистрация: 23.12.2012

03.03.2010 14:23:33

Для этого макроса не нужен прогресс-бар.

Надо убрать из кода все Select-ы и ActiveWindow.SmallScroll-ы, отключить в начале макроса обновление экрана (application.ScreenUpdating=False),
ну и за одним уж оптимизировать копирование.

Тогда макрос будет выполняться моментально.

Надстройки для Excel Парсинг сайтов Мониторинг цен конкурентов

gaz-polutorka

Пользователь

Сообщений: 160 Регистрация: 22.12.2012

Мой ник без пробелов, но через тире @yandex.ru и будет моя почта!

03.03.2010 14:31:21

Спасибо большое EducatedFoll,

Сейчас всё попробую, но если не сложно будет, сделайте мне его для наглядности, просто ради интереса.

Если это много времени занимает, то ненадо конечно=)

Ещё раз спасибо!
С уважением,
Александр

gaz-polutorka Пользователь Сообщений: 160 Регистрация: 22.12.2012 Мой ник без пробелов, но через тире @yandex.ru и будет моя почта!	#5 03.03.2010 14:45:01 Если все Select'ы убрать, то начинает ошибку рисовать. надо после range("##"). что-то писать, а что?! Подскажите неучу пожалуйста=))

Guest Гость	#6 03.03.2010 15:30:25 Всё завелось, спасибо, но обновляет секунд 15-20 примерно, потому как я выложил только кусочек макроса, а он у меня как простыня позиций на 100-120...

Guest Гость	#7 03.03.2010 16:14:33 Круть, так ещё и смотриться не как простыня, а кратенько! Спасибо большое!

gaz-polutorka Пользователь Сообщений: 160 Регистрация: 22.12.2012 Мой ник без пробелов, но через тире @yandex.ru и будет моя почта!	#8 10.03.2010 14:02:17 Помогите пожалуйста Range("A" & li).Paste Вот эта команда не работает. Мне кажется что ошибка таиться в скобках, т.е он букву А и переменное значение li в таком виде не воспринимает. Что делать? Как выйти из ситуации? Весь макрос, выше на два сообщения от The_Prist Спасибо!

Читают тему