Имею такой код... почемуто с надстройкой не открываются документы, Ехел грузиться с панелью инструментов, а сам документ не отображается=(  
в чем может быть проблема?  
 
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

Понимаю, что вот здесь можно 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

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

Добрый день!  
 
Как можно ускорить процесс ввода выпадающего списка в ячейки. Сделал так:  
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 и выпадающий список вводится не во все ячейки =((

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

в ячейки Лист1.Cells(n, 4) значение 10.03.2011  
Пользуюсь  
Start=Format(Format(Лист1.Cells(n, 4), "MMMM"), "<") ' нашел на форуме, плохо понимаю, что делает  
получаю Start= "март"  
 
а как, чтобы Start= "Март" С большой буквой?

Вечер добрый!  
Выкладываю свой первый проект =) не судите строго  
 
но, я не все реализовал в нем. Не понимаю, как можно отпуска на листе "сотрудники"  выводить в табель и маркировать "О")  
 
Подскажите пожалуйста  
<EM><STRONG>Файл удален</STRONG> - велик размер - [<STRONG>МОДЕРАТОРЫ</STRONG>]</EM>

Ночи доброй!  
имею вот такое:  
With Cells(m, x)  
   .Value = "Â"  
   .Borders.Weight = xlThin  
   .Interior.Color = RGB(153, 204, 255)  
   .HorizontalAlignment = xlCenter ' ну очень замедляет процесс вывода ячейки!!!  
End With  
может другой подход имеется (выравнивание по центру)??!

Добрый день!    
Есть переменная indxList As Integer, которая принимает значение от 0 до 11 (т.е. indexList может принять только одно значение от 0 до 11).  
Я использую    
Select Case indxList    
Case 0  
…  
Case 1  
…  
Case 2  
…  
…  
Case 11  
End Select  
Подскажете, как можно еще сделать?!

=)) Опять я с глупыми, простыми вопросами…  
Имею 2 листа. Хочу сделать так, чтобы данные с первого листа переносились во 2-ой  
Private Sub CommandButton1_Click()  
Dim n As Integer  
m = Range("A12").CurrentRegion.Rows.Count “! Не могу понять, что он возвращает, т.е. до А12 у меня пусто. В А12 «Фамилия» и потом пусто  
Dim s(0)  ‘!!!!! Понимаю, что не так должно быть! А как – НЕ ЗНЕЮ =(  
Set s(0) = Лист1 ‘!!!!  
n = 6  
Do While s(0).Cells(n, 1) <> Empty  
Cells(m, 1) = s(0).Cells(n, 1)  “!!! И тут не клеится! Вроде указал, с какой ячейки смотреть “A12” , но все равно начинает вводить с А1  
Cells(m, 2) = s(0).Cells(n, 2)”  
m = m + 1  
n = n + 1  
Loop  
End Sub

Добрый день! Еще раз =))  
На листе  Sh1 имеется диапазон ячеек Range(D11:AH30)  
Пытаюсь сделать так, чтобы при нажатии правой клавиши 1 раз - ячейка окрашивалась в красный цвет. Используя событие Sub Workbook_SheetBeforeRightClick()  
А при  Sub Workbook_SheetBeforeDoubleClick()  -  цвет убирался

Вот сижу и думаю....  
В определенный диапазон я вывожу количество дней в месяце и присваиваю значение "8"  
как можно сделать, чтобы в этом диапазоне выходные дни окрашивались в красный цвет и имели значение "-"  
вот часть кода...  
 
intQuntityDay = DateDiff("d", DateValue(MyDate1), DateValue(MyDate2)  
Set RangeTab = Range(Cells(11 + m, 4), Cells(11 + m, 34))  
For j = 1 To intQuntityDay    
       RangeTab.Cells.Item(1, j).Value = "8"  
Next j

Добрый день!  
еще зелен в VBA...  
Хочу сделать, чтобы из формы при выборе ChekcBox... данный выводились в свободную! ячейку С6  и далеее  
 
Dim ArrName(1 To 5) As Boolean  
Dim n As Integer  
 
ArrName(1) = CheckBox1 ' Checkbox1.Caption = "Пятак 1"  
ArrName(2) = CheckBox2 ' Checkbox1.Caption = "Пятак 2"  
ArrName(3) = CheckBox3 ' Checkbox1.Caption = "Пятак 3"    
ArrName(4) = CheckBox4 ' Checkbox1.Caption = "Пятак 4"  
ArrName(5) = ChechBox5 ' Checkbox1.Caption = "Пятак 5"  
   
For j = 1 To 5  
   If ArrName(j) = True Then  
   '!!!!! Не знаю как это сделать правильно!!!  
   'Хочу, чтобы проверял на наличие пустых ячеек с "С5"  
   '  
   'n = Range("C5").CurrentRegion.Rows.Count  
   'Cells(n + 1, 1).Value = "1"    
   Beep  
   End If  
Next j