Модераторы: mihanik

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Создание в менню списка листов, Немогу создать список листов в виде меню 
V
    Опции темы
ArNic
Дата 3.1.2007, 10:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 278
Регистрация: 3.1.2007

Репутация: нет
Всего: нет
Итак, есть рабочая книга! У нее около 15 листов, 4 из которых основных (ярлычки у них белые, их не трогаем), далее идут поставщики (синие, зеленые). Все это различается по цвету, порядку (сначала основные, потом другие) и этим самым определяется за нал или за безнал. работают.
С помощью кода
Код

'...
For kards = 1 To 1000
 If Worksheets(kards).Tab.ColorIndex <> -4142 Then
    Exit For
End If
Next
'...

определяем до какого момента у нас идут листы с белыми ярлычками т.е. основные листы
Код

'...
MWS = 5
On Error Resume Next
Vipiska_a = 2
For es = kards To 1000
    If Worksheets(es) Is Nothing Then
        Exit For
    Else
        WSN = Worksheets(es).Name
        noga = "'" & WSN & "'!A1"
        Worksheets("Общая форма").Hyperlinks.Add Anchor:=Worksheets("Общая форма").Cells(MWS, 2), Address:="", SubAddress:=noga, ScreenTip:="Жми для перехода к карточке", TextToDisplay:=WSN
        MWS = MWS + 1
next
'...


Я хочу перенести список листов в меню
Чтобы при выполнении auto_open создавался аналогично список в меню! Но! Пункты меню не предполагают использование hyperlink поэтому не знаю что делать! Помогите, пожалуйста!
PM MAIL ICQ   Вверх
Naghual
Дата 3.1.2007, 10:49 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1893
Регистрация: 15.5.2004
Где: Украина, Днепр

Репутация: 7
Всего: 49
Ну и где попытка размещения в меню? Я вообще не вижу работы с меню.
Посмотри соллекцию CommandBars офиса.


--------------------
Я желаю всем Счастья!
PM ICQ Skype   Вверх
ArNic
Дата 3.1.2007, 11:05 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 278
Регистрация: 3.1.2007

Репутация: нет
Всего: нет
было таким
Код

Private Sub Auto_open()
MenuBars(xlWorksheet).Menus.Add Caption:="[Взаиморасчеты]"

MenuBars(xlWorksheet).Menus("[Взаиморасчеты]").MenuItems.Add Caption:="На Главную", OnAction:="Going_Main"
MenuBars(xlWorksheet).Menus("[Взаиморасчеты]").MenuItems.Add Caption:="К выписке", OnAction:="Going_Vipis"
MenuBars(xlWorksheet).Menus("[Взаиморасчеты]").MenuItems.Add Caption:="-"

Set VZR_0 = MenuBars(xlWorksheet).Menus("[Взаиморасчеты]").MenuItems.AddMenu("Обновление")
VZR_0.MenuItems.Add Caption:="Списка карточек", OnAction:="UPD_Main"

MenuBars(xlWorksheet).Menus("[Взаиморасчеты]").MenuItems.Add Caption:="-"

Set VZR_1 = MenuBars(xlWorksheet).Menus("[Взаиморасчеты]").MenuItems.AddMenu("Групповые операции")
VZR_1.MenuItems.Add Caption:="Перезаеркпить шапки", OnAction:="Freeze"
VZR_1.MenuItems.Add Caption:="Установить масштабы", OnAction:="Zoomer"
VZR_1.MenuItems.Add Caption:="Определить отношение к компаниям", OnAction:="Update_Companys"

End Sub


хочется часть сделать такой

Код

'...
MenuBars(xlWorksheet).Menus.Add Caption:="[Взаиморасчеты]"
'...
Set VZR_2 = MenuBars(xlWorksheet).Menus("[Взаиморасчеты]").MenuItems.AddMenu("Переход")
For kards = 1 To 1000
    If Worksheets(kards).Tab.ColorIndex <> -4142 Then
        Exit For
    End If
Next

On Error Resume Next
Vipiska_a = 2
For es = kards To 1000
    If Worksheets(es) Is Nothing Then
        Exit For
    Else
        WSN = Worksheets(es).Name
        ssilka = "'" & WSN & "'!A1"
        VZR_2.MenuItems.Add Caption:=WSN, OnAction:=ssilka
next
Но ведь так нельзя, а процедуры на каждый лист создавать долго и неперспективно!
PM MAIL ICQ   Вверх
Naghual
Дата 3.1.2007, 11:52 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1893
Регистрация: 15.5.2004
Где: Украина, Днепр

Репутация: 7
Всего: 49
не усложняй себе жизнь.
в цикле создавай менюхи, и OnAction:="SomeSub(" & i & ")"



--------------------
Я желаю всем Счастья!
PM ICQ Skype   Вверх
ArNic
Дата 3.1.2007, 12:00 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 278
Регистрация: 3.1.2007

Репутация: нет
Всего: нет
Я не понял
 smile 
PM MAIL ICQ   Вверх
ArNic
Дата 3.1.2007, 12:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 278
Регистрация: 3.1.2007

Репутация: нет
Всего: нет
Пробовал н получается опиши подробнее
PM MAIL ICQ   Вверх
Naghual
Дата 3.1.2007, 14:44 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1893
Регистрация: 15.5.2004
Где: Украина, Днепр

Репутация: 7
Всего: 49
Описываю:
Код
MenuBars(xlWorksheet).Menus("[Взаиморасчеты]").MenuItems.Add "Перейти к " & CStr(i), "GoToSheet(" & Str(i) & ") "



и в модуле книги создаеш процедуру:
Код
Public Sub GoToSheet(intIndex As Integer)
    MsgBox "Item " & intIndex
End Sub


Добавлено @ 14:47 
По ходу, увидел не понятное для меня поведение Екселя:
По одному клику меню, вызов процедуры OnAction выполняется дважды. Посему вот решение:

Модуль Книги:
Код
Private MenuClickCount As Integer

Public Sub GoToSheet(intIndex As Integer)
    MenuClickCount = MenuClickCount + 1
    If MenuClickCount = 2 Then
        ReallyGoToSheet intIndex
        MenuClickCount = 0
    End If
End Sub

Public Sub ReallyGoToSheet(intIndex As Integer)
    MsgBox "Item " & intIndex
End Sub



Ну и тестовый код WorkBook:
Код


Private Sub Workbook_BeforeClose(Cancel As Boolean)
    MenuBars(xlWorksheet).Menus("[Взаиморасчеты]").Delete
End Sub

Private Sub Workbook_Open()
    Dim i As Integer
    
    MenuBars(xlWorksheet).Menus.Add "[Взаиморасчеты]"
    MenuBars(xlWorksheet).Menus("[Взаиморасчеты]").MenuItems.Add Caption:="На Главную", OnAction:="Going_Main"
    MenuBars(xlWorksheet).Menus("[Взаиморасчеты]").MenuItems.Add Caption:="К выписке", OnAction:="Going_Vipis"
    MenuBars(xlWorksheet).Menus("[Взаиморасчеты]").MenuItems.Add Caption:="-"
    
    For i = 0 To 5
        MenuBars(xlWorksheet).Menus("[Взаиморасчеты]").MenuItems.Add _
            "Перейти к " & CStr(i), "GoToSheet(" & CStr(i) & ") "
    Next i
End Sub



--------------------
Я желаю всем Счастья!
PM ICQ Skype   Вверх
ArNic
Дата 3.1.2007, 15:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 278
Регистрация: 3.1.2007

Репутация: нет
Всего: нет
Спасибо за помощь! Очень помогли!
PM MAIL ICQ   Вверх
ArNic
Дата 3.1.2007, 16:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 278
Регистрация: 3.1.2007

Репутация: нет
Всего: нет
Все конечно прекрасно, но не выполняется команда 

Код

WorkSheets(intIndex).select


Просто не выполняется и все - заранее спасибо!
PM MAIL ICQ   Вверх
Naghual
Дата 3.1.2007, 18:30 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1893
Регистрация: 15.5.2004
Где: Украина, Днепр

Репутация: 7
Всего: 49
Хм... Фигня какаято...
Будем думать...


--------------------
Я желаю всем Счастья!
PM ICQ Skype   Вверх
ArNic
Дата 4.1.2007, 08:45 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 278
Регистрация: 3.1.2007

Репутация: нет
Всего: нет
Возможно при работе с меню работа с листами не возможна?

Это сообщение отредактировал(а) ArNic - 4.1.2007, 08:48
PM MAIL ICQ   Вверх
ArNic
Дата 4.1.2007, 15:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 278
Регистрация: 3.1.2007

Репутация: нет
Всего: нет
Проблема осталась открытой - как ни бился (6 часов без чашки кофе и похода в туалет smile ), а всеравно не получается. Даже уважаемый Naghual, ито задумался! Может кто поможет!
PM MAIL ICQ   Вверх
ArNic
Дата 14.2.2007, 10:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 278
Регистрация: 3.1.2007

Репутация: нет
Всего: нет
Никто не сможет помочь в решении данной проблеммы?

Это сообщение отредактировал(а) ArNic - 14.2.2007, 10:22
PM MAIL ICQ   Вверх
Naghual
Дата 14.2.2007, 12:18 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1893
Регистрация: 15.5.2004
Где: Украина, Днепр

Репутация: 7
Всего: 49
Я в тупике.


--------------------
Я желаю всем Счастья!
PM ICQ Skype   Вверх
Genyaa
Дата 14.2.2007, 16:15 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Усердный
*


Профиль
Группа: Участник
Сообщений: 154
Регистрация: 25.9.2006
Где: Москва

Репутация: 2
Всего: 11
Вот что у меня вышло.. может поможет:

Код

Public Sub MenuWork()
    Dim cb As CommandBar

    On Error Resume Next
    CommandBars(1).Controls("Листы книги").Delete 'отладочная часть - удаляет старое на всякий случай
    On Error GoTo 0
    
    Set cb = Application.CommandBars(1) '("Worksheet Menu Bar")
    
    With cb
        .Visible = True
        With .Controls.Add(Type:=msoControlPopup) ', Before:=cb.Controls.Count) - без этого параметра пункт будет справа от Справка, с ним - предпоследним
            .Caption = "Листы книги"   'имя пункта меню
            For Each ss In ActiveWorkbook.Sheets
                With .Controls.Add(Type:=msoControlButton, ID:=2949)
                    .Caption = ss.Name
                    .OnAction = "ssAct"
                End With
            Next ss
            .CommandBar.Protection = MsoBarProtection.msoBarNoCustomize
        End With
    End With
End Sub

Sub ssAct()
    Sheets(CommandBars.ActionControl.Caption).Activate
End Sub

--------------------
Всякое решение плодит новые проблемы.
PM WWW   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Программирование, связанное с MS Office"
mihanik staruha

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами


  • Несанкционированная реклама на форуме запрещена
  • Пожалуйста, давайте своим темам осмысленный, информативный заголовок. Вопль "Помогите!" таковым не является.
  • Чем полнее и яснее Вы изложите проблему, тем быстрее мы её решим.
  • Оставляйте свои записи в "Книге отзывов о работе администрации"
  • А вот тут лежит FAQ нашего подраздела

Если Вам понравилась атмосфера форума, заходите к нам чаще!
С уважением mihanik и staruha.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Программирование, связанное с MS Office | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0602 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.