ReSQL.ru
     
powered by simpleCommunicator - 2.0.59     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Помогите оптимизировать код
8 сообщений из 8, страница 1 из 1
Помогите оптимизировать код
    #38938315
Сергей06
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Сергей06
Участник
Добрый день!
Помогите оптимизировать код.
Не нравится, что использую много .Activate


Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
 Sub ИзменениеСсылок_Пусто_на_Факт()
     ' изменение ссылок
         aLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
         Set xlWrkbk = ActiveWorkbook
         If Not IsEmpty(aLinks) Then
           For i = 1 To UBound(aLinks)
             If UCase(Right(aLinks(i), 4)) = "XLSM" Then ' Проверка что это "XLSM" файл
                If Left(aLinks(i), 11) = "Disk:\papka" Then
                  If Right(aLinks(i), 6) = "_.xlsm" Then
                      НовыйПуть = Replace(aLinks(i), "_.xlsm", "_факт.xlsm")
                      Workbooks.Open (НовыйПуть), UpdateLinks:=True
                      Set xlWrkbk2 = ActiveWorkbook
                      xlWrkbk.Activate
                      ActiveWorkbook.ChangeLink Name:=aLinks(i), NewName:=НовыйПуть, Type:=xlExcelLinks 
                      xlWrkbk2.Close SaveChanges:=False
                      'xlWrkbk.Activete
                  End If
                End If
             End If
           Next i
         End If
End Sub
...
Рейтинг: 0 / 0
16.04.2015, 14:18
| Ответить | Цитировать | Написать  
Помогите оптимизировать код
    #38938320
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
Так не используйте, в чем проблема?

http://www.sql.ru/faq/faq_topic.aspx?fid=4344
...
Рейтинг: 0 / 0
16.04.2015, 14:22
| Ответить | Цитировать | Написать  
Помогите оптимизировать код
    #38938347
Сергей06
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Сергей06
Участник
Shocker.Pro,

Подобный вопрос о селект задавал.
Применение метода Select в VBA

но я редко пишу макросы, поэтому не до конца понимаю, как верно исключить такие команды.
...
Рейтинг: 0 / 0
16.04.2015, 14:47
| Ответить | Цитировать | Написать  
Помогите оптимизировать код
    #38938348
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
макрос работает в пределах одной книги?
...
Рейтинг: 0 / 0
16.04.2015, 14:48
| Ответить | Цитировать | Написать  
Помогите оптимизировать код
    #38938536
Сергей06
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Сергей06
Участник
Shocker.Pro, да, в данном случае т.к. книг две, то легче их открыть и вручную запустить макрос.

вот так смог открыть книгу:
Код: vbnet
1.
Workbooks.Open (НовыйПуть), UpdateLinks:=True


но, почему подобным образом закрыть ее не могу.
поэтому пошел кривым путем: активировать ее, потом закрывать.
с этой строкой вроде понятно:
Код: vbnet
1.
ActiveWorkbook.ChangeLink Name:=aLinks(i), NewName:=НовыйПуть, Type:=xlExcelLinks

нужно записать так
Код: vbnet
1.
xlWrkbk.ChangeLink Name:=aLinks(i), NewName:=НовыйПуть, Type:=xlExcelLinks
...
Рейтинг: 0 / 0
16.04.2015, 17:36
| Ответить | Цитировать | Написать  
Помогите оптимизировать код
    #38938545
Казанский
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Казанский
Гость
Так попробуйте. Вы уверены, что нужно открывать книгу, на которую идет ссылка?
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
Sub ИзменениеСсылок_Пусто_на_Факт()
     ' изменение ссылок
         aLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
         Set xlWrkbk = ActiveWorkbook
         If Not IsEmpty(aLinks) Then
           For i = 1 To UBound(aLinks)
             If UCase(Right(aLinks(i), 4)) = "XLSM" Then ' Проверка что это "XLSM" файл
                If Left(aLinks(i), 11) = "Disk:\papka" Then
                  If Right(aLinks(i), 6) = "_.xlsm" Then
                      НовыйПуть = Replace(aLinks(i), "_.xlsm", "_факт.xlsm")
                      Set xlWrkbk2 = Workbooks.Open(НовыйПуть, UpdateLinks:=True)
                      xlWrkbk.ChangeLink Name:=aLinks(i), NewName:=НовыйПуть, Type:=xlExcelLinks
                      xlWrkbk2.Close SaveChanges:=False
                      'xlWrkbk.Activete
                  End If
                End If
             End If
           Next i
         End If
End Sub
...
Рейтинг: 0 / 0
16.04.2015, 17:43
| Ответить | Цитировать | Написать  
Помогите оптимизировать код
    #38938547
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
Я дал ссылку на FAQ - там есть ответы на все эти вопросы - прочтите.
...
Рейтинг: 0 / 0
16.04.2015, 17:43
| Ответить | Цитировать | Написать  
Помогите оптимизировать код
    #38938613
Сергей06
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Сергей06
Участник
Shocker.Pro,
спасибо
...
Рейтинг: 0 / 0
16.04.2015, 18:35
| Ответить | Цитировать | Написать  
8 сообщений из 8, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Помогите оптимизировать код
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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