Доброго времени суток друзья!  
 
Возник вопрос, пусть покажется кому глупым и не нужным, но все же :)  
 
Например, при распаковке файла встроенным в Windows архиватором Zip создается временная папка в папке для мусора "Temp" (где папка "Temp" расположена - знает только владелец своего ПК, но это не важно), в которую помещается упакованный файл.    
Знаю, что ее можно определить по средствам "FSO" (Set FSO = CreateObject("scripting.filesystemobject")), подсмотрел в макросе от Ron de Bruin. Но данный метод мне не подходит, так как неустановленна для этого нужная библиотека.  
 
Теперь вопрос :)  
 
Каким способом можно еще определить имя созданной временной папки, пусть будет как в приведенном мною примере, при распаковке файла?  
 
Заранее благодарю за любую оказанную помощь!

Доброго Всем времени суток дорогие Планетчане!  
Давно темы не создавал, вот решил напомнить о себе :)  
 
Использую следующие действия для извлечения из строки (полного пути к файлу) только имена файла и папки.  
-----------------------------------------  
Sub NamesFileDir()  
   Dim sFullName$, vArr, sFullFileName$, sDirName$, sFileName$  
   sFullName = "C:\Test1\Test2\Test___5\Книга1.xls"  
   vArr = Split97(sFullName, Application.PathSeparator)  
   sFullFileName = vArr(UBound(vArr))  
   sDirName = Left(sFullName, Len(sFullName) - (Len(sFullFileName) + 1))  
   vArr = Split97(sDirName, Application.PathSeparator)  
   sDirName = vArr(UBound(vArr))  
   vArr = Split97(sFullFileName, ".")  
   sFileName = Left(sFullFileName, Len(sFullFileName) - (Len(vArr(UBound(vArr))) + 1))  
   MsgBox "Имя файла: " & sFileName & ", имя папки: " & sDirName  
End Sub  
 
Function Split97(vStr As Variant, sSeparator As String) As Variant  
'   Разделитель текста в строке  
   Split97 = Evaluate("{""" & Application.Substitute(vStr, sSeparator, """,""") & """}")  
End Function  
-----------------------------------------  
 
Все работает, но хочу попросить Вашей помощи в оптимизации.  
Хочется верить, что есть более компактное решение ;)  
 
Заранее спасибо за любую помощь!  
 
P.S. Функция не мое изобретение, когда-то нашел ее на форуме, за что отдельное спасибо автору ;)

Всем, доброго времени суток! :)  
 
Что-то к вечеру голова тяжелая...  
 
Не могу сообразить, как заполнить массив данными из следующего цикла.  
------------------------------------------------------------  
Dim Arr()  
       For li = Me.ListBox1.ListCount - 1 To 0 Step -1  
           If Me.ListBox1.Selected(li) = True Then  
               Rows(li + 10).Copy  
               Range(Me.RefEdit1).Offset(1, 0).Insert Shift:=xlDown  
'дальше не знаю  
Arr(li) = li + 10 'это мои неправильные соображения  
           End If  
       Next li  
------------------------------------------------------------  
 
Помогите, пожалуйста, кто чем может ;)

Доброго времени суток всем! :)  
 
Вчера помогал в решение задачи и на первый взгляд показалось, что помог. Но не тут-то было. Оказалось, что не умею искать часть элемента коллекции в коллекции (а может и нельзя). :(  
Поэтому и обращаюсь к Вам, уважаемые Планетчани и просто друзья, за помощью :)  
Пример прилагается.  
 
P.S. Сильно не пинайте, давно вопросы не задавал ;)

Доброго всем времени суток!  
 
То ли не выспался, то ли заклинило, но не могу понять в чем же суть проблемы. :)  
 
Код:  
-----------------------  
Private Sub Worksheet_Change(ByVal Target As Excel.Range)  
   Dim rClmIndex  
   rClmIndex = Target.Column  
   If Target.Cells.Count = 1 Then  
       FirstAdr = Target.Address(False, False)  
           If rClmIndex = 12 Then If Not IsEmpty(Target) And Not IsNumber(Target) Then Target.Text = "" ' ошибка выделяет "IsNumber"  
   End If  
End Sub  
-----------------------  
 
Помогите пожалуйся! Объясните, что делаю не так :(

Всем доброго времени суток! :)  
 
Нашел когда-то на Планете пример календаря на VBA.    
Подправил его под свои нужды и вот решил выложить его, авось кому-то и пригодится.  
А возможно еще какая-то добрая душа поможет его довести до ума (даже в дизайнерском плане).  
 
Жду любые предложения и пожелания.    
 
P.S. Если испортил чей-то шедевр - извините, не со зла. ;)  
 
-=44409=-

Доброго времени суток друзья! :)  
 
Подскажите, пожалуйста, как запретить отображение окна ввода пароля при открытии книги Excel?!  
 
Или игнорировать или чтобы пользователь его не видел (лучше конечно - не видел), чтобы после ошибки отобразить MsgBox?! :)  
 
22223

Доброго времени суток Всем! :)  
     
Подскажите пожалуйста, правильно ли я добавил метод "Quit"?!  
 
-------------  
'какой-то код...  
With Application  
.DisplayAlerts = True  
.Visible = True  
.EnableCancelKey = xlInterrupt  
.Quit  
End With  
ThisWorkbook.Close False  
-------------  
 
Хотел добиться закрытия (полностью закрыть) Excel и кажется добился, но мало ли что. :)

Доброго времени суток Всем!  
 
Создал макрос для поиска одинаковых значений в 2-х одинаковых таблицах, которые расположены в разных книгах.    
Таблицы по структуре полностью идентичны, только разное количество строк.  
Сам макрос находится в отдельной книге, для удобства.  
 
Вот собствено макрос:  
----------------------  
Private Sub Процесс_Бар()  
   Dim i As Long, j As Long  
   Dim База_Last_Row As Long, Наша_Last_Row As Long  
   Dim Счетчик As Long  
   Dim R, База_Путь As String  
   Dim База_Имя As String, База As String  
   Dim База_Книга As Workbook, Наша_Книга As Workbook  
   Dim База_Лист As Worksheet, Наш_Лист As Worksheet  
   Dim Мин As Long, Макс As Long  
'    On Error Resume Next  
   With Application  
       .Interactive = False  
       .EnableEvents = False  
       .ScreenUpdating = False  
       .DisplayAlerts = False  
       .Visible = False  
       .Wait Time:=Now + TimeValue("0:00:01")  
       Set Наша_Книга = ActiveWorkbook 'эта книга уже открыта  
       Set Наш_Лист = Наша_Книга.ActiveSheet  
       База_Путь = "C:\Test\"  
       База_Имя = "Test.xls"  
       База = База_Путь & База_Имя  
       Workbooks.Open Filename:=База, UpdateLinks:=0, Password:="123"  
       Set База_Книга = ActiveWorkbook  
       Set База_Лист = База_Книга.Sheets("реєстр")  
       База_Last_Row = База_Лист.UsedRange.Row + База_Лист.UsedRange.Rows.Count - 1  
       База_Last_Row = Val(База_Last_Row) - 28  
       Наша_Last_Row = Наш_Лист.UsedRange.Row + Наш_Лист.UsedRange.Rows.Count - 1  
       Наша_Last_Row = Val(Наша_Last_Row) - 28  
       Счетчик = 0  
       Процесс_Бар.Min = 0  
       Процесс_Бар.Max = База_Last_Row  
       Процесс_Бар.Value = 0  
       For i = 10 To База_Last_Row  
           R = База_Лист.Cells(i, Union([B1], [F1], [G1], [H1], _
               [J1], [L1], [N1], [P1], [Q1], [R1], [S1]).Columns).Text
                   If Наш_Лист.Cells(j, Union([B1], [F1], [G1], [H1], _
               [J1], [L1], [N1], [P1], [Q1], [R1], [S1]).Columns).Text = R Then
                       Наш_Лист.Cells(j, 1).Interior.ColorIndex = 6  
                   End If  
               Next  
           Счетчик = Счетчик + 1  
           DoEvents  
           Процесс_Бар.Value = Счетчик  
       Next  
       База_Книга.Close False  
       Set Наша_Книга = Nothing  
       Set Наш_Лист = Nothing  
       Set База_Книга = Nothing  
       Set База_Лист = Nothing  
       .ScreenUpdating = True  
       .EnableEvents = True  
       .DisplayAlerts = True  
       .Visible = True  
       .Interactive = True  
   End With  
   ThisWorkbook.Close False  
End Sub  
----------------------  
 
Макрос рабочий, хотя иногда не все ячейки выделяет, где одинаковые значения (на 98-99% выполняет поставленную задачу).  
 
Поэтому прошу Всех по возможности посмотреть, проверить (хотя бы визуально) и исправить (дополнить) данный макрос.  
 
Так же буду рад любым комментарием (ответам).  
 
P.S. За онсову взят макрос Юрия (Юрий М). За что ему большое спасибо!

Доброго времени суток!  
 
Не думал, что понадобится вставлять формулы с помощью макросов, но понадобилось.  :(  
 
Есть файл, в который я добавил макрос.  
Макрос, автоматически вставляет данные в определенную ячейку во время перемещения по ячейкам.  
 
Код:  
----------------  
...  
Тест = "ОКРУГЛ(B" & Val(iAddress) & "*C" & Val(iAddress) & "*D" & Val(iAddress) & ";2)"  
Range("H" & iAddress).Value = Тест  
...  
----------------    
 
Но если я перед "ОКРУГЛ" добавляю "=", тоесть хочу вставить формулу - выдает ошибку :(  
 
Помогите пожалуйста!

Доброго времени суток всем!  
 
Помогите пожалуйста усовершенствовать следующий макрос:  
 
--------------------------  
Sub Скрыть_Столбцы()  
   'прячем необходимые столбцы  
   With Application  
       .EnableCancelKey = xlDisabled  
       .ScreenUpdating = False  
       Columns(3).Hidden = True  
       Columns(5).Hidden = True  
       Columns(13).Hidden = True  
       Columns(15).Hidden = True  
       .ScreenUpdating = True  
       .EnableCancelKey = xlInterrupt  
   End With  
End Sub  
--------------------------

Доброго времени суток, уважаемые форумчани!  
 
В Excel существует функция "Параметры шифравания файла этой книги", где есть опция "Пароль для открытия:".  
 
Установить "Пароль для открытия:" с помощью VBA не составляет труда.  
 
Например, установил в "Книга1.xls" пароль "123" с помощью такого кода:  
 
----------------------  
Sub Макрос1()  
   ThisWorkbook.Password = "123"  
End Sub  
----------------------  
 
сохранил и закрыл. Все работает замечательно.  
 
Теперь хочу сделать так, чтобы "Книга1.xls" открывалась и пароль вводился при помощи VBA (естественно с включенными макросами).    
 
С помощью макрорекордера вышло следующее (снятие пароля):  
 
----------------------  
ThisWorkbook.Password = ""  
----------------------  
 
Записал на открытие (думал получится):  
 
----------------------  
Private Sub Workbook_Open()  
   ThisWorkbook.Password = ""  
End Sub  
----------------------  
 
но не получилось, просит ввести пароль.  
 
Возможно ли это осуществить с помощью VBA?    
Если "да", прошу Вас помочь с макросом!

Доброго времени суток Всем!  
 
Столкнулся с такой задачей.  
 
Имеется форма, в ней "TexBox". В этом "TexBox" необходимо вводить только дату.    
Все что я смог придумать следующее:  
 
-----------------------------------  
Public Откл_Events As Boolean  
 
Private Sub Поле_Дан_Дата_Change()  
   If Len(Me.Поле_Дан_Дата.Text) = 11 Then  
       If Not Me.Поле_Дан_Дата Like "##.##.####" Then  
           If Not IsDate(Me.Поле_Дан_Дата.Text) Then  
               Откл_Events = True  
               Me.Поле_Дан_Дата.SelStart = 0  
               Me.Поле_Дан_Дата.SelLength = Len(Me.Поле_Дан_Дата.Text)  
               Откл_Events = False  
           End If  
       End If  
   End If  
End Sub  
 
Private Sub Поле_Дан_Дата_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)  
   'если в поле введена не цифра, то отменяем ввод символа (от "." до "9")  
   If KeyAscii < 46 Or KeyAscii > 57 Then KeyAscii = 0  
End Sub  
 
Private Sub Поле_Дан_Дата_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)  
   'запрещаем вставлять скопированное значение в поле  
   If KeyCode = vbKeyV And Shift = 2 Then KeyCode = 0  
End Sub  
-----------------------------------  
 
Проверка идет если введено 10 знаков, хотя все коряво...если точки вводить, можно и больше... :(  
 
Возможно все-таки, что-то сделать, чтобы в "TexBox" можно было вводить только дату (формат даты)?!  
 
P.S.знаю, что есть дополнительные элементы управления, но на работе их добавить не могу :(

Доброго времени суток, друзья!  
 
Пожалуйста, уделите мне немного времени и разъясните (хотя бы двумя словами), когда именно необходимо задействовать "On Error GoTo 0" ?! :)  
 
P.S. догадываюсь, но это только догадки, могу и ошибаться...

Доброго времени суток!  
 
Уважаемые форумчани, помогите пожалуйста разобраться с методом Find.  
 
Вот уже час пытаюсь понять, как им искать в диапазоне нужный текст с помощью формы.  
 
Создал форму, в ней "TexBox" (где ввожу название) и кнопку "Найти".  
Вот начало кода:  
------------------------------    
Dim Город As Range  
Set Город = Sheets("Города").Range("A1:A10").Find(What:=UserForm.Поле_Город)  
...  
------------------------------  
 
Код работает, но ищет название города даже по введенной первой (правильной) букве, даже с малой.  
 
Как заставить искать полное название города с помощью метода "Find"?!

Доброго времени суток!  
 
Понимаю, что не новость и возможно уже этот вопрос поднимался, но поиском не нашел ничего подходящего.  
 
Пытаюсь сделать следующее.  
При открытии книги, мне необходимо найти в ней определенные листы (2-а листа) и если в этой книги такие листы существуют, выполнить кое-какие действия.    
Додумался до следующего, но хотелось бы, чтобы грамотные люди посмотрели и помогли оптимизировать или исправить часть моего кода:  
 
--------------------------------------------------------  
Dim Лист As Worksheet  
Dim Лист_1 As String, Лист_2 As String  
...  
With ActiveWorkbook  
'присваиваем переменным "Лист_1" и "Лист_2" имена искомых листов  
Лист_1 = "Один": Лист_2 = "Два"  
'перебор листов в открытой книге  
For Each Лист In .Worksheets  
'если искомые листы существуют, выполняем следующее ...  
If Лист.Name = Л_Реестр And Лист.Name = Л_Настройки Then  
...  
--------------------------------------------------------  
 
Заранее спасибо!

Доброго времени суток!  
 
Помогите пожалуйста!  
Проблема такая.  
Создал небольшую программу с помощью макросов. Все работало отлично, но после обработки этой программки на другом менее стареньком компьютере я не могу открыть ее у себя на компьютере, начало ругаться сначало на библиотеки - исправил, теперь вот такая ошибка :(  
 
Ругается на строчку:  
Public ComBar As CommandBar  
 
P.S. на остальных компьютерах с разными характеристиками и установленными программами работает на ура... :(

Доброго времени суток!  
 
Для того, чтобы можно было работать с двумя открытыми книгами, мне необходимо 2-е переменные "Книга1" и "Книга2" (Книга1 - рабочая книга, Книга2 - любая открытая из которой черпаем информацию).  
 
Вот начало кода:  
set Книга1 = ThisWorkbook  
set Книга2 =    
 
Подскажите пожалуйста, что нужно написать после равно?!  
 
Знаю, что можно так:  
iFile = Dir(SelectedItem, vbDirectory)  
но в данном случае не подходит.  
 
P.S. Возможно снова неправильно описал свою проблему, поэтому прошу задавать вопросы, буду исправляться.

Доброго времени суток!  
 
Прошу описать применение функцию "Set" на доступном языке :)  
 
Особенно интересует когда обязательно объявлять:  
Set "Переменная" = Nothing  
а когда нет.  
 
Спасибо заранее!  
 
P.S. буду рад любому Вашему ответу, даже короткому ;)

Доброго времени суток!  
 
Пытаюсь уже второй день удалить в открытой другой книге все модули и т.д.  
 
Существует отличный код который это действие выполняет:  
                               For Each iVBComponent In .VBProject.VBComponents  
                                   With iVBComponent  
                                        Select Case .Type  
                                            Case 1 To 3: .Collection.Remove iVBComponent  
                                            Case 100: .CodeModule.DeleteLines _  
                                            1, .CodeModule.CountOfLines  
                                        End Select  
                                   End With  
                               Next iVBComponent  
 
Но он, то работает, то нет. В тестовой книге создал кнопку "Открыть книгу", при открытии задействовал этот код, все получилось (при условии, что открытая книга активна).  
 
Вставляю в свою книгу - не работает. Если вот так изменить "For Each iVBComponent In ThisWorkbook.VBProject.VBComponents" удаляет в моей книге без проблем :)  
 
Пробовал и ActiveWorkbook и Workbooks("Название") - не работает :(  
 
Прошу помочь! ;)

Доброго времени суток!  
 
Подскажите пожалуйста, из-за чего может не вызывается из открытой книги событие:  
Call SendKeys("%{F11}", True)  
 
если нажимаю самостоятельно "Alt" + "F11", работает...

Доброго времени суток!  
 
Помогите пожалуйста со следующим.  
 
Есть определенный файл (файл1), где я защитил VBProject, соответственно знаю пароль (123).  
 
Возможно ли, работая в другом файле (файл2), в котором есть кнопка "Снять защиту файла1", после открытия файл1 в VBProject снять защиту (нажав данную кнопку) при помощи макроса?!

Доброго времени суток!  
 
Возможно вопрос и обсуждался на Планете, но к своему сожалению не могу смотреть все темы на форуме так как стоят ограничения.  
 
Работая в файле Excel возможно макросом поставить уровень безопасности высокий, если да, прошу привести пример.  
 
Заранее спасибо!

Доброго времени суток!  
 
Столкнулся с такой задачей.  
 
Есть некая ячейка "F15" (точный адресс при открытии файла) на листе "Лист1" в файле, которую перед закрытием файла, Пользователь обязан заполнить.    
Но когда Пользователь работает в файле, он добавляет-удаляет строки, сколько - неизвестно. Получается, что данная ячейка "F15" меняет свой адресс и уже будет "F.." (неизвестный номер).  
 
Это можно как-то учесть при закрытии файла и заставить Пользователя заполнить ее, если он этого не сделал?!

Доброго времени суток!  
 
Подскажите пожалуйста, как обратиться к определенному столбцу (например, десятому)скрытого листа (например, "Лист3") в котором постоянно добавляются ячейки?!  
 
Точнее, пробую таким образом:  
 
Sub Количество()  
For Each cell In Лист3.UsedRange.Columns(10).Cells  
If cell.Value <> vbEmpty Then iCount = iCount + 1  
Next cell  
End With  
MsgBox "Количество ячеек: " & iCount & "!", 16, "Внимание!"  
End Sub  
 
Или, "Лист3.UsedRange.Columns(3).Cells" - это правильно?

Доброго времени суток!  
 
Пытаюсь запретить сохранение других книг в открытой рабочей книге.  
 
Существует такой код:  
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)  
Cancel = True  
End Sub  
 
Но он запрещает сохранять текущею книгу.  
 
Пробовал прикрутить:  
If iBook.Name <> Me.Name Then Cancel = True  
 
Но возникает ошибка.  
 
Подскажите, возможно ли запретить сохранение книг, кроме текущей?!  
Если возможно, наведите пожалуйста небольшой пример.  
 
Заранее спасибо!

Доброго времени суток!  
 
Столкнулся с такой задачей.  
Имеется определенный файл с макросами Excel 2003, в котором будут работать Пользователи.  
Необходимо, чтобы при работе в этом файле Excel, другие файлы Excel - не открывались.  
Точнее, чтобы они вообще не могли открыться.  
 
Пробовал так:  
Private WithEvents App As Application  
Private Sub App_WorkbookOpen(ByVal Wb As Workbook)  
   With Application  
       .EnableCancelKey = xlDisabled  
       .ScreenUpdating = False  
       .EnableEvents = False  
       If Wb.Name <> Me.Name Then  
           Wb.Close False  
           MsgBox "Нельзя открывать файлы Excel!", 16, "Ошибка!"  
       End If  
       .EnableEvents = True  
       .ScreenUpdating = True  
       .EnableCancelKey = xlInterrupt  
   End With  
End Sub  
 
Но файл всеравно открывается...  
 
Или возможно, чтобы макросы при открытии других файлов не срабатовали?!