Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Меню с переходом по листам / 14 сообщений из 14, страница 1 из 1
22.10.2010, 15:38
    #36914902
Tatirus
Tatirus
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Меню с переходом по листам
Помогите, пожалуйста, с такой задачкой!
Есть необходимость создания нового меню с названием "ЛИСТЫ", при нажатии на которое раскрывался бы список листов данной книги Excel. Через настройку я такое меню создала, написала в модуль книги макросы перехода по листам и присвоила эти макросы настраиваемым кнопкам новому меню "ЛИСТЫ". Переход по листам в работает, но возникли следующие проблемы:
- у других пользователей (на других ПК) данное меню не отображается
- если книгу перенести, например, в другую папку на моем ПК, то отображается сообщение "Не найден макрос.....", т.е. меню не работает
- на моем ПК меню появляется при открытии любого файла Excel, а нужно, чтобы оно втсраивалось только в меню того файла, где я его создала

И еще: для создания такого меню я для каждого листа писала макрос перехода к нему. Т.е. при добавлении нового листа надо будет опять писать новый макрос и встраивать его в меню "ЛИСТЫ", иначе в меню он не появится (сам) :)) Можно ли как-нибудь автоматизировать этот процесс, т.к. с файлом будут работать другие пользователи, которые не смогут самостоятельно проделать эту процедуру, а я не всегда доступна.

На всякий случай пример прилагаю.

P.S. Не уверена, что пишу в нужный топик :))
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
24.10.2010, 14:50
    #36916592
alex77755
alex77755
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Меню с переходом по листам
Вот, примерно, так
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
25.10.2010, 10:46
    #36917366
Tatirus
Tatirus
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Меню с переходом по листам
alex77755,

Переход по листам не работает (( Появляется сообщение "Не найден макрос....."
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
25.10.2010, 10:54
    #36917384
Tatirus
Tatirus
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Меню с переходом по листам
alex77755,

Вот такое сообщение: см. файл
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
25.10.2010, 12:41
    #36917704
alex77755
alex77755
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Меню с переходом по листам
Запусти ексел и из него открой файл.
Потом Alt+F11 и в ЭтаКнига - макрос
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
25.10.2010, 12:51
    #36917732
alex77755
alex77755
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Меню с переходом по листам
вставь код в ЭтаКнига
Код: 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.
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim L
Dim S As Object
Dim ТекстПроцедуры
Dim xlmodule As Workbook 'Object
Set xlmodule = ActiveWorkbook
'удаляем все макросы из Лист1  (других макросов сюда не ложить)
On Error Resume Next
For L = xlmodule.VBProject.VBComponents( 2 ).CodeModule.CountOfLines To  1  Step - 1 
 xlmodule.VBProject.VBComponents( 2 ).CodeModule.DeleteLines L,  1 
Next L
Application.CommandBars("Worksheet Menu Bar").Controls("Листы").Delete
Set S = Application.CommandBars("Worksheet Menu Bar")
With Application.CommandBars("Worksheet Menu Bar")
'Создание строки меню Файл
        With .Controls.Add(Type:=msoControlPopup)
                .Caption = "&Листы"
                With .Controls
                        For L =  1  To Sheets.Count
ТекстПроцедуры = "Public Sub Налист" & L & "()" & vbCrLf & "Sheets(" & """" & Sheets(L).Name & """" & ").Select" & vbCrLf & "End sub"
  xlmodule.VBProject.VBComponents( 2 ).CodeModule.AddFromString ТекстПроцедуры
                         With .Add(Type:=msoControlButton)
                        .Caption = Sheets(L).Name
                         Debug.Print "Налист" & Sheets(L).Name
                        .OnAction = "Лист1.Налист" & L
                     End With
                Next L
                End With
        End With
End With
End Sub
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
25.10.2010, 12:53
    #36917738
alex77755
alex77755
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Меню с переходом по листам
при щелче по любой ячейке кроме активной - появится меню с именами листов
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
26.10.2010, 10:03
    #36919641
Tatirus
Tatirus
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Меню с переходом по листам
alex77755при щелче по любой ячейке кроме активной - появится меню с именами листов
Все сделала: создала новый файл, вставила макрос в ЭтаКнига, щелкнула - меню Листы появилось. При попытке перейти к листу - VB опять ругается ((( (см. прилагаемый файл)
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
26.10.2010, 22:59
    #36921581
alex77755
alex77755
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Меню с переходом по листам
Ну не знаю! у меня работает.
Проверь разрешена ли работа макросов?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
26.10.2010, 23:00
    #36921586
alex77755
alex77755
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Меню с переходом по листам
Какой у тебя офис?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
27.10.2010, 12:04
    #36922329
Tatirus
Tatirus
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Меню с переходом по листам
alex77755Какой у тебя офис?

MS Office 2003, работа макросов разрешена
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
27.10.2010, 12:10
    #36922352
Tatirus
Tatirus
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Меню с переходом по листам
Файл скачала себе на диск в папку. После разархивирования файла в
ту же папку, все макросы работали. Но когда файл скопировала в другую папку, макросы перестали работать, стали ругаться, что невозможно найти такой макрос... Очень странно. ((
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
28.10.2010, 00:23
    #36924424
alex77755
alex77755
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Меню с переходом по листам
Проверил - всё работает. Макрос же даже не в модуле, а в самой книге.
Одно ограничение: нельзя удалять лист с индексом 1
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
28.10.2010, 00:51
    #36924462
alex77755
alex77755
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Меню с переходом по листам
Возми открой ексел пустую книгу.
Зайди в редактор и вставь код в ЭтаКнига.
Теперь макросы будут записываться в Эта книга и удалять можно любой лист:

Код: 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.
35.
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim L
Dim S As Object
Dim FI
Dim ТекстПроцедуры
Dim xlmodule As Workbook 'Object
Set xlmodule = ActiveWorkbook

'удаляем все макросы из Лист1  (других макросов сюда не ложить)
On Error Resume Next
For L = xlmodule.VBProject.VBComponents( 1 ).CodeModule.CountOfLines To  1  Step - 1 
FI = Left(xlmodule.VBProject.VBComponents( 1 ).CodeModule.Lines(L,  1 ),  17 )
 Debug.Print xlmodule.VBProject.VBComponents( 1 ).CodeModule.Lines(L,  1 )
If FI = "Public Sub Налист" Then
 xlmodule.VBProject.VBComponents( 1 ).CodeModule.DeleteLines L,  3 
 End If
Next L
Application.CommandBars("Worksheet Menu Bar").Controls("Листы").Delete
Set S = Application.CommandBars("Worksheet Menu Bar")
With Application.CommandBars("Worksheet Menu Bar")
'Создание строки меню Файл
        With .Controls.Add(Type:=msoControlPopup)
                .Caption = "&Листы"
                With .Controls
                        For L =  1  To Sheets.Count
ТекстПроцедуры = "Public Sub Налист" & L & "()" & vbCrLf & "Sheets(" & """" & Sheets(L).Name & """" & ").Select" & vbCrLf & "End sub"
  xlmodule.VBProject.VBComponents( 1 ).CodeModule.AddFromString ТекстПроцедуры
                         With .Add(Type:=msoControlButton)
                        .Caption = Sheets(L).Name
                        .OnAction = "ЭтаКнига.Налист" & L
                     End With
                Next L
                End With
        End With
End With
End Sub
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Меню с переходом по листам / 14 сообщений из 14, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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