убрал For i = 1 To 1000: DoEvents: Next - заработало =))

Симптомы такие:    
Запускаю чисто Excel.exe Сервис -> Надстройки Кнопку «Обзор». Все красиво. Надстройка подцепилась.  
Закрываем Excel.exe  
Если открыть пример.xls - Excel запускается (видно окно, панель управления + надстройка) но содержимое файла пример.xls не видно (нет ни одного листа) =(((  
 
А вот если запустить Excel.exe – запускается и панельки и Листы в кол-ве 3 шт.  
=(((  
Даже не знаю…..

{quote}{login=The_Prist}{date=29.03.2011 02:36}{thema=}{post}Так у Вас файл как надстройка сохранен - xla? и при открытии его Вы не видите листов? Это логично - файлы надстроек и должны быть скрыты. Хотите работать с этим файлом - сохраниете его как xls.  
 
Или вообще никакие файлы не грузятся при открытой надстройке?  
 
P.S. почему две одинаковых темы?{/post}{/quote}  
 
Файл сохранет в XLA. ДА! при открытии любово xls файлика отображается панель управления + сама надстройка (я ее подключаю через-> Сервис -> Надстройки Кнопку «Обзор»),но вот сами листы с информацией не отображается!?  
 
Р.S. Не видел, что 2 темы

Имею такой код... почемуто с надстройкой не открываются документы, Ехел грузиться с панелью инструментов, а сам документ не отображается=(  
в чем может быть проблема?  
 
Private Sub Workbook_Open()  
   ФормированиеПанелиИнструментов  
End Sub  
Private Sub Workbook_BeforeClose(Cancel As Boolean)  
   On Error Resume Next  
   Application.CommandBars("VTB").Delete  
End Sub  
Sub ФормированиеПанелиИнструментов()  
   On Error Resume Next  
   Application.ScreenUpdating = False  
   Application.DisplayAlerts = False  
   'Application.CommandBars.Add(Name:="VTB").Visible = True  
   Set x = Application.CommandBars.Add("VTB", msoBarTop)  
   x.Visible = True  
   x.Controls.Add(msoControlPopup).Caption = "addclient"  
   For i = 1 To 1000: DoEvents: Next  
   Set ShapesCB = Application.CommandBars("VTB")  
   For Each co In ShapesCB.Controls: co.Delete: Next  
   ShapesCB.Visible = True  
   ShapesCB.Controls(1).BeginGroup = True  
   If ShapesCB.Controls.Count = 0 Then Add_Control_Ex ShapesCB, 1, 354, "СформироватьПисьмаКлиентам", "Сформировать Письма Клиентам", True  
   Add_Control_Ex ShapesCB, 1, 2148, "СформироватьДокуметыДепозитыМБ", "Сформировать Депозиты", True  
   Add_Control_Ex ShapesCB, 1, 213, "ДобавитьСтроки", "Добавить Строки", True  
   Add_Control_Ex ShapesCB, 1, 2141, "СформироватьДокументыИП", "Сформировать документы ИП", False  
   Add_Control_Ex ShapesCB, 1, 52, "СформироватьДокументыЮрЛиц", "Сформировать документы ЮрЛиц", False  
   Add_Control_Ex ShapesCB, 1, 19, "СформироватьДоговоры", "Сформировать Договоры", False  
     
   Application.ScreenUpdating = True  
   Application.DisplayAlerts = True  
     
End Sub  
Function Add_Control_Ex(ByRef menu, ByVal B_Type As Integer, ByVal B_Face As Integer, _  
                       ByVal On_Action As String, ByVal B_Caption As String, Optional ByVal Begin_Group As Boolean = False, Optional Tag As String = "") As CommandBarControl  
' добавляет контролы в меню menu ' type=1 - это кнопка, type=4 - это комбобокс, 10 - popup  
   On Error Resume Next  
   Set Add_Control_Ex = menu.Controls.Add(B_Type, , , 1)  
   With Add_Control_Ex  
       If B_Face > 0 Then .FaceId = B_Face:  
       .Tag = Tag: .OnAction = On_Action: .Caption = B_Caption: If Begin_Group Then .BeginGroup = True  
   End With  
End Function

Имею такой код... почему-то с надстройкой не открываются документы, Ехел грузиться с панелью инструментов, а сам документ не отображается=(  
в чем может быть проблема?  
 
Private Sub Workbook_Open()  
   ФормированиеПанелиИнструментов  
End Sub  
Private Sub Workbook_BeforeClose(Cancel As Boolean)  
   On Error Resume Next  
   Application.CommandBars("VTB").Delete  
End Sub  
 
 
Sub ФормированиеПанелиИнструментов()  
 
   On Error Resume Next  
     
   Application.ScreenUpdating = False  
   Application.DisplayAlerts = False  
         
   'Application.CommandBars.Add(Name:="VTB").Visible = True  
   Set x = Application.CommandBars.Add("VTB", msoBarTop)  
   x.Visible = True  
   x.Controls.Add(msoControlPopup).Caption = "addclient"  
     
   For i = 1 To 1000: DoEvents: Next  
 
   Set ShapesCB = Application.CommandBars("VTB")  
   For Each co In ShapesCB.Controls: co.Delete: Next  
   ShapesCB.Visible = True  
   ShapesCB.Controls(1).BeginGroup = True  
 
   If ShapesCB.Controls.Count = 0 Then Add_Control_Ex ShapesCB, 1, 354, "СформироватьПисьмаКлиентам", "Сформировать Письма Клиентам", True  
   Add_Control_Ex ShapesCB, 1, 2148, "СформироватьДокуметыДепозитыМБ", "Сформировать Депозиты", True  
   Add_Control_Ex ShapesCB, 1, 213, "ДобавитьСтроки", "Добавить Строки", True  
   Add_Control_Ex ShapesCB, 1, 2141, "СформироватьДокументыИП", "Сформировать документы ИП", False  
   Add_Control_Ex ShapesCB, 1, 52, "СформироватьДокументыЮрЛиц", "Сформировать документы ЮрЛиц", False  
   Add_Control_Ex ShapesCB, 1, 19, "СформироватьДоговоры", "Сформировать Договоры", False  
     
   Application.ScreenUpdating = True  
   Application.DisplayAlerts = True  
     
End Sub  
Function Add_Control_Ex(ByRef menu, ByVal B_Type As Integer, ByVal B_Face As Integer, _  
                       ByVal On_Action As String, ByVal B_Caption As String, Optional ByVal Begin_Group As Boolean = False, Optional Tag As String = "") As CommandBarControl  
' добавляет контролы в меню menu ' type=1 - это кнопка, type=4 - это комбобокс, 10 - popup  
   On Error Resume Next  
   Set Add_Control_Ex = menu.Controls.Add(B_Type, , , 1)  
   With Add_Control_Ex  
       If B_Face > 0 Then .FaceId = B_Face:  
       .Tag = Tag: .OnAction = On_Action: .Caption = B_Caption: If Begin_Group Then .BeginGroup = True  
   End With  
End Function

{quote}{login=слэн}{date=28.03.2011 03:53}{thema=}{post}можно, конечно, и так...  
 
но Вы же спрашивали о другом?  
 
Sub t()  
   Dim x As CommandBar  
   Set x = Application.CommandBars.Add("vtb", msoBarTop)  
   x.Visible = True  
   x.Controls.Add(msoControlPopup).Caption = "addclient"  
End Sub{/post}{/quote}  
 
ОО! вот там мне более понятней! спасибо

как-то так?  
 
MenuPos = Application.CommandBars(1).FindControl(ID:=30010).Index + 1  
Set VTBMenu = Application.CommandBars(1).Controls.Add(Type:=msoControlPopup, Before:=MenuPos, temporary:=True)

Понимаю, что вот здесь можно Application.CommandBars.Add(Name:="VTB").Visible = True  
но как ее закрепить вверху, там где все панели управления?!  
 
Sub ФормированиеПанелиИнструментов()  
   On Error Resume Next  
   Application.ScreenUpdating = False  
   Application.CommandBars.Add(Name:="VTB").Visible = True  
   For i = 1 To 1000: DoEvents: Next  
 
   Set ShapesCB = Application.CommandBars("VTB")  
   For Each co In ShapesCB.Controls: co.Delete: Next  
   ShapesCB.Visible = True  
   ShapesCB.Controls(1).BeginGroup = True  
 
   If ShapesCB.Controls.Count = 0 Then Add_Control_Ex ShapesCB, 1, 354, "СформироватьПисьмаКлиентам", "Сформировать Письма Клиентам", True  
   Add_Control_Ex ShapesCB, 1, 2148, "СформироватьДокуметыДепозитыМБ", "Сформировать Депозиты", True  
   Add_Control_Ex ShapesCB, 1, 213, "ДобавитьСтроки", "Добавить Строки", True  
   Add_Control_Ex ShapesCB, 1, 2141, "СформироватьДокументыИП", "Сформировать документы ИП", False  
   Add_Control_Ex ShapesCB, 1, 52, "СформироватьДокументыЮрЛиц", "Сформировать документы ЮрЛиц", False  
   Add_Control_Ex ShapesCB, 1, 19, "СформироватьДоговоры", "Сформировать Договоры", False  
     
End Sub  
Function Add_Control_Ex(ByRef menu, ByVal B_Type As Integer, ByVal B_Face As Integer, _  
                       ByVal On_Action As String, ByVal B_Caption As String, Optional ByVal Begin_Group As Boolean = False, Optional Tag As String = "") As CommandBarControl  
' добавляет контролы в меню menu ' type=1 - это кнопка, type=4 - это комбобокс, 10 - popup  
   On Error Resume Next  
   Set Add_Control_Ex = menu.Controls.Add(B_Type, , , 1)  
   With Add_Control_Ex  
       If B_Face > 0 Then .FaceId = B_Face:  
       .Tag = Tag: .OnAction = On_Action: .Caption = B_Caption: If Begin_Group Then .BeginGroup = True  
   End With  
End Function

The_Prist, спасибо!! + хороший сайтик подкинули, овтеты на мои глупые вопросы =))  
я тоже так думаю, сначала в библиотеку а потом с вопросами =))  
 
не думал, что обработчик ошибки On Error так важен! поставил перед If - заработало!!!  
 
On Error Resume Next  
If Worksheets(Range("A11").Value) Is Nothing Then  
Worksheets("Основной").Copy , After:=Worksheets(Worksheets.Count)  
Worksheets(Worksheets.Count).Name = Range("A11").Value  
Worksheets("Основной").Activate  
Else  
MsgBox ("Существует лист" & Range("A11").Value)  
Exit Sub  
End If

выдает Март 2011 года  
 
Если навести на Range("A11").Value в режиме отладки выдает Range("A11").Value ="Март 2011 года" а  вот Worksheets(Range("A11").Value) =<Subscript out of range>

может потому, что Range("A11") объединенная ячейка?

Спасибо! книжка как-то странно написана    
Только в Главе 13 Обработка ошибок и отладка программы стр 351 - еще не дочитал =)  
А то, что все время обращается к активному листу (Worksheets) - нормально, макрос выполняется на одном листе "Основной" и оттуда берет Range("A11").Value  
 
а в отладке пишет  
 
Worksheets(Range("A11").Value) =<Subscript out of range> ?! это как =((

Хоть все равно не работает...  
но, вместо Elce -> Else =)

что-то не клеится....  
 
If Worksheets(Range("A11").Value) Is Nothing Then  
   Worksheets("Основной").Copy , After:=Worksheets(Worksheets.Count)  
   Worksheets(Worksheets.Count).Name = Range("A11").Value  
   Worksheets("Основной").Activate  
Elce  
MsgBox ("Существует лист" & Range("A11").Value)  
       Exit Sub  
End If  
 
??

Утро доброе!  
Есть лист «Основной» , Range("A11").Value на листе может принимать значение «Январь», «Февраль» и т.д.  Макрос может создавать копии «Основного»  листа со значением Range("A11").Value. ! как описать , чтобы копий не имели одинаковых имен?  
Думал сделать так. Но ругается, так как если в книге таких листов нет, то…  
If Worksheets(Range("A11").Value) = Range("A11").Value Then  
      MsgBox ("Cуществует  " & Range("A11").Value)  
End If  
Вот как-то так =))

Доработал =))  
 
в табеле можно выбирать: Выходной день, отпуск, отпуск за свой счет, командировку, болезнь  
 
трудимся дальше

{quote}{login=KukLP}{date=06.03.2011 03:16}{thema=}{post}Да нет же. Программно определяете последнюю заполненную строку(на форуме примеров полно) и назначаете диапазон.{/post}{/quote}  
 
Точно! Спасибо! Всем Спасибо!!! =))

{quote}{login=Юрий М}{date=06.03.2011 02:46}{thema=}{post}Если разговор только о выпадающих списках, то в общем случае можно так (для одной ячейки):  
[C3].Validation.Delete
[C3].Validation.Add Type:=xlValidateList, Formula1:=("Я, 8, О, Б")
А теперь берём цикл, и...{/post}{/quote}  
 
те же яй..а! только в другом соусе =)  
Excel подвисает

Про диапазон я думал. как-то квадратно. Получается, если надо заполнить таблицу на 40 строк, то и 60 следующих строк - тоже! тока зачем, файлик и так под 1 мб забивают эти 40 строк =))

не все добавил =))  
Sub AddValidationList(ByRef ce As Range)  
   With ce  
       With .Validation      
           .Delete  
           .Add Type:=xlValidateList, AlertStyle:=xlValidAlertInformation, Operator:= _  
                xlBetween, Formula1:=", Я, 8, В, О"  
           .IgnoreBlank = True: .InCellDropdown = True  
       End With  
       .FormatConditions.Delete  
       .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""Я"""  
         
       .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""8"""  
         
       .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""В"""  
       .FormatConditions(3).Interior.Color = RGB(153, 204, 255)    
       .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""О"""  
       .FormatConditions(4).Interior.Color = RGB(194, 214, 154)      
   End With  
End Sub

Добрый день!  
 
Как можно ускорить процесс ввода выпадающего списка в ячейки. Сделал так:  
Dim cell As Range  
Do While Лист1.Cells(n, 1) <> Empty  
....  
....  
For Each cell In Range(Cells(m, 3), Cells(m, 33))    
AddValidationList cell  
Next  
loop  
 
Sub AddValidationList(ByRef ce As Range)  
   With ce  
       .FormatConditions.Delete  
       .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""Я"""  
       .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""8"""  
       .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""О"""  
       .FormatConditions(3).Interior.Color = RGB(153, 204, 255)    
       .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""Б"""  
       .FormatConditions(4).Interior.Color = RGB(194, 214, 154)  
   End With  
End Sub  
 
Вроде работает! но, когда Лист1.Cells(n, 1) больше чем 20, подвисает Excel и выпадающий список вводится не во все ячейки =((

Действительно!  
я вот искоса смотрел на Application.Calculation = xlCalculationManual  
 
Посоветовали поставить перед формированием таблицы, для ускорения =)  
 
Application.Calculation = xlCalculationManual  
Application.ScreenUpdating = False ' понимаю для чего  
   
Спасибо за информацию

вот

хм! очень странно, вроде проверял - работала функция  
 
Cells(m, 36).FormulaR1C1 = "=COUNTIF(RC3:RC33,""OT"")"  
 
а вот теперь удаляю ОТ в диапазоне RC3:RC33 - и Cells(m, 36) значение не меняется  
в чем может быть проблема?!

{quote}{login=The_Prist}{date=05.03.2011 02:50}{thema=}{post}Кстати, у меня в формуле опечатка - только сейчас увидел. Вместо точки-с-запятой нужно двоеточия:  
Cells(m, 36).FormulaR1C1 = "=COUNTIF(RC3:RC33,""OT"")"{/post}{/quote}  
 
=)) Я и сам хорош. Пишу -  а потом разбираюсь!

Макрос запускается. но, запускается один раз - формирует табель  
 
The_Prist, то что нужно! только я первый раз поставил - не пошло  
Начал разбираться - Cells(m, 36).FormulaR1C1 = "=COUNTIF(RC3:RC33,""OT"")"  
 
вместо ; надо :!  
 
Всем спасибо!

Вы не так меня поняли.  
ОТ - записано у меня без кавычек, т.е. считает он правильно  
 
т.е. если ОТ в диапазоне Range(Cells(m, 3), Cells(m, 33) 12 шт - покажет 12 шт  
 
а вот после, т.е. когда таблица сформирована, я хочу удалить одно ОТ - как было 12 шт так и останется  
 
Вот я и хотел, чтобы в Cells(m, 36) вводилась формула, которая следила за изменением в диапазоне. Добавил я там ОТ или убрал.

Юрий М, это работает  
Cells(m, 36) = Application.WorksheetFunction.CountIf(Range(Cells(m, 3), Cells(m, 33)), "ОТ")  
 
но если я налисте в диапазоне Range(Cells(m, 3), Cells(m, 33) ставлю еще "ОТ"  
Cells(m, 36) - не пересчитывает =((

Пишу так  
 
Cells(m, 36).FormulaR1C1 = "=COUNTIF(Cells(m, 3):Cells(m, 33),""OT"")"  
 
на листе получаю так  
 
=СЧЁТЕСЛИ(Cells(m; 3):Cells(m; 33);"ОТ")  
 
в чем проблема?

Утро доброе!  
Теперь думаю над тем как обработать данные в табеле  
Т.е. хочу, чтобы в ячейки очередной отпуск вводилась функция,  которая просматривала диапазон и там где «ОТ» суммировала. И в итоге возвращала кол-во дней отпуска =))