» Excel VBA (часть 2)

to Wowgun:
Лист изначально один (ну или три по умолчанию, два удаляем)... В день X может быть несколько дел, выглядит это как строки (первый столбец - даты):


Присутствовали
Зам по этому Пупкинд
Зам по тому Кошкинд
Зам по другому Мышкинд


Протокол совещания:

|XX.XX.XXXX|Сделать новую курилку для ИТР, отв Пупкинд В.В.
|XX.XX.XXXX|Напоить всех ИТР до белки, отв Путин В.В.
|XY.XX.XXXX|...


Одних и тех же дел, вроде как быть не может, т.к. заполняется-то вручную, все-таки...

ol7ca

Цитата:

Как сделать, чтобы проходя по активному файлу, код выбирал лист с тем же
именем в искомом файле?

В дополнение к предыдущему моему сообщению (отвлекли, не успел дописать).
Это можно сделать проще и код будет более понятным. У вас всё-таки много повторений в коде. Я бы на вашем месте, научился бы пользоваться указателями на объекты, чтобы не писать каждый раз Workbooks("map3.xls").Sheets(j).Cells(i, "AB").
Вот мои замечания:
1) Переменные: k as integer, ws As Worksheet, wb As Workbook, v As Variant, temp_range As Range вы их вводите но не пользуетесь.
2) Мне всё-таки до конца не понятно, чего вы хотите от своего кода: файл-источник map3.xls, файл приёмник b3.xls. Что должно у вас получиться: кто из них активный файл?

Как я догадываюсь, у вас есть какой-то файл (номер 1), в котором есть листы с определёнными именами. Вы перебираете все листа в файле номер 1 и ищите листы с теми же именами в файле номер 2. Если вы находите 2 листа с одинаковыми именами, то вы делаете какую-то операцию с данными. Если вы какой-то определённый лист из файла номер 1 не нашли в файле номер 2, то опять мне не понятно, то ли вы пропускаете этот лист, то ли что-то ещё делаете.

В общем, пишите свои пояснения к задаче, будем решать.

nick7inc
мой первый код был короче и проще, но когда не заладилось, я начал эксперименты и стал директивно указывать обьекты и повторять. В итоге добился работы кода, при условии что количество листов в обоих файлах одинаково - что уже является результатом. А дальше - я с вопросами тут, чтобы не через "выхлопную трубу" а нормальным путем решить задачу-)
По крайней мере я уже что-то сделал сам и что-то в этом соображаю - так легче подсказать.
мне так кажется.

Файл-источник map3.xls, файл приёмник b3.xls, b3.xls активный в момент нажатия кнопки, в него должны попасть данные из map3.xls, при условии, что имена листов совпали. Если нет такого листа, то ищем следующий.
Суть процедуры: map3.xls - промежуточный файл, туда я загружаю данные, делаю с ними некоторые операции и проверяю на ошибки. Он является урезанной репликой b3.xls, поэтому названия листов совпадут, а лишние листы из b3.xls должны быть пропущены кодом. b3.xls - файл чистовик (как в школе-)).

ol7ca
Отлично. Делим задачу на части (как в школе). [more=Далее]
Точка запуска кода - процедура ttt().

1) Нам надо пройти по всем листам b3.xls. Для этого нужно воспользоваться циклом For..Next. Нам надо получить имя листа, а не его номер. В вашем коде вы сравниваете по номерам, что неправильно, поскольку количество листов и их порядок в файлах может отличаться. Можно использовать 2 варианта для получения имени листа:

Код: Dim sheet_walker as Worksheet , sheet_walk_name As String

For Each sheet_walker in Workbooks("b3.xls").Sheets
sheet_walk_name = sheet_walker.Name
[...] ' здесь располагается основной код
Next sheet_walker

Цитата:

DocBeen

Цитата:Вопрос тогда, а как можно тогда сделать надстройку со своими макросами чтоб потом установив их на пользовательской машинке запускать...


Я думаю, что есть несколько способов и могу описать только те, которыми пользовался сам.
1) Если вы планируете писать свои функции для использования их в качестве формул на листе в ячейках, то вызов осуществляется так же, как если бы они были у вас написаны в текущей книге, например, у меня в ячейке набит вызов моего макроса (из XLA), который после обсчёта возвращает результат: =Calculate_isomerisation_2_5($F5;$G5;$H5;$B$25)
2) Если вы планируете вызывать макросы из VBA, то можно воспользоваться функцией Run():

Код:Application.Run "ExcelLib1_Extension.Optimization.Fit", var1, var2, Deriv, DStop, One_parametr_fit, fine_tune_mode


, где ExcelLib1_Extension - название моего проекта, то есть AddIn'а (в VBA правой клавишей по вашему проекту в окне Projects, Свойства и там указываете уникальное имя); Optimization - имя модуля; Fit - имя моей функции. Только будьте осторожнее с параметрами, проверяйте типы и порядок.
3) Если вы сохраните книгу с макросами опцией "Сохранить как, XLA", то вы сохраните AddIn только для своей системной учётной записи и все книги, которые будут использовать функции-макросы (описанные в пункте 1) будут после сохранения жёстко привязаны к папке с вашим AddIn'ом, что создаст трудности, если зайти под другим пользователем на компьютер или перенести файл с данными на другой. Поэтому сохранять AddIn лучше в папку Library ("C:\Program files\Microsoft Office2K\Office\Library"), тогда AddIn будет 1) виден для всех пользователей и 2) не будет жёсткой привязки к его местоположению при использовании ваших функций-макросов на листе. Путь к папке Library можно получить при помощи Application.LibraryPath.
4) Я ещё использую AddIn для создания собственных кнопок на панели инструментов, что мне сильно помогает в работе:

Я из этого не понял почти ни чего,
прошу прощения конечно, просто не сильно уж я и разбираюсь в Надстройках ...

Хотелось бы реализовать по максимуму надстройку, включить в нее свои макросы и работать с любой книгой, вызывая их кнопками из этой надстройки...

Вкратце:
Хотелось бы надстройку - которую можно было бы использовать на любой машинке, где бы она не запускалась, настройка же сама содержит массу макросов - которые вызываются кнопками их панели Надстройки.

Помогите пожалуйста

nick7inc

огромное спасибо за пример и обстоятельные обьяснения.

Tox0
если строки с датами начинаются с 10-й строки, столбца А, то можно так ...

Sub Макрос1()

Range("A10").Select
r = Selection.End(xlDown).Row

Range("A10:A" & r).Select
Range("A10:A" & r).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"A" & r + 5), Unique:=True
Range("A" & r + 5).Select

r2 = Selection.End(xlDown).Row

For i = 1 To r2 - r - 5
n = Sheets("Лист1").Range("A" & r + 5 + i)
Sheets.Add
ActiveSheet.Name = n
k = 0
For i1 = 0 To r - 1
If Sheets("Лист1").Range("A" & 10 + i1) = n Then
Range("A" & 10 + k) = Sheets("Лист1").Range("B" & 10 + i1)
k = k + 1
End If
Next
Next

Sheets("Лист1").Select
Range("A" & r + 5 & ":" & "A" & r2).Select
Selection.ClearContents

Range("A1").Select
End Sub

Здравствуйте! помогите пожалуйста очень нужно!
Нужно создать табель учета рабочего времени в эксель, чтобы автоматически можно выбирать месяц и год, и даты заносились в готовый шаблон, в выделенные ячейки! причем все это делалось через форму, форма есть, проблемма с написанием процедуры!

Natylay

поможет ...

http://planetaexcel.ru/tip.php?aid=105&PHPSESSID=2e27a14efba4898610235ad53e57339a
http://planetaexcel.ru/tip.php?aid=53&PHPSESSID=2e27a14efba4898610235ad53e57339a

надеюсь НЕ расценят как рекламу ...

Запуск других приложений не семейства MS OFFICE
Как можно запустить блокнот и вставить туда данные из буфера обмена?

vasiliy74

Код: Sub Notepad()
Dim ReturnValue
ReturnValue = Shell("NOTEPAD.EXE", 1) ' Запускаем блокнот
AppActivate ReturnValue ' Активизируем блокнот
SendKeys "+{INSERT}", True 'Вставляем данные из буфера обмена
End Sub

WowGun
Спасибо огромнейшее, но мне это не много не подходит!
иеются 12 месяцев, каждый месяц имеет определенное колличество дней, необходимо, чтобы при выбаре месяца, в диапазон выделенных ячеек проставлялись дни, а вернее чилс от 1 до конца месяца!
и еще вопрос, как сделать так, чтобы можно было занести рабочее время в ячейку определенного дня или командировку, если такая имеется? Например рабочий день составлет 8,2 часов 1 марта, вот чтобы это число попало в эту ячейку, а 2 марта человек уехал в командировку!
Заранее благодарна, очень нужно!

НЕ видя файла примера - ТРУДНО что-то ПРЕДПОЛОЖИТЬ ...
а здесь файлы НЕ прикрепишь ... как я понимаю ...

либо в ЛИЧКУ .. и на другой форум, либо по МЫЛУ ...

WowGun а какой у вас адрес или аська есть или агент?

Natylay, это, безусловно Ваше дело - куда выкладывать файл и кого спрашивать...
но, думаю, что будет лучше, если Вы подготовите тестовый файл. Напишите, что нужно получить - можно прямо кинуть надпись/автофигуру и в ней написать требование,
полученный xls файл запакуете и выложите на любой бесплатный хостинг (например, http://rapidshare.com или http://zalil.ru или ifolder.ru или ...) и полученную ссылку на файл опубликуете здесь, в форуме. Тогда вероятность того, что Ваша задача будет решена быстрее/качественнее гораздо выше...

Natylay
Гляньте в ЛЯ.

SERGE_BLIZNUK
Спасибо за совет!

VBA формирует список из полей LDAP (AD)
Как бы сделать что бы WMI считывал со всех компов класс software (что установленно)?


Код: Option Explicit
Const ADS_SCOPE_SUBTREE = 2
Sub LoadUserInfo()
Dim x, objConnection, objCommand, objRecordSet, oUser, oSamAccountName, omail, oDescription, otelephoneNumber, oCompany, otitle, odepartment
Dim sht As Worksheet

' get domain
Dim oRoot
Set oRoot = GetObject("LDAP://rootDSE")
'Set oRoot =
Dim sDomain
sDomain = oRoot.Get("defaultNamingContext")
Dim strLDAP
strLDAP = "LDAP://" & sDomain

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 100
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

objCommand.CommandText = "SELECT adsPath FROM '" & strLDAP & "' WHERE objectCategory='person'AND objectClass='user'"
Set objRecordSet = objCommand.Execute

x = 2
Set sht = ThisWorkbook.Worksheets("Sheet1")
With sht
' Clear and set Header info
.Cells.Clear
.Cells(1, 1).Value = "CN"
.Cells(1, 2).Value = "Last Name"
.Cells(1, 3).Value = "First Name"
.Cells(1, 4).Value = "Display Name"
.Cells(1, 5).Value = "SamAccountNanme"
.Cells(1, 6).Value = "mail"
.Cells(1, 7).Value = "Description"
.Cells(1, 8).Value = "telephoneNumber"
.Cells(1, 9).Value = "Company"
.Cells(1, 10).Value = "Title"
.Cells(1, 11).Value = "department"
Do Until objRecordSet.EOF
Set oUser = GetObject(objRecordSet.Fields("aDSPath"))
.Cells(x, 1).Value = Replace(oUser.Name, "CN=", "")
.Cells(x, 2).Value = oUser.SN
.Cells(x, 3).Value = oUser.givenName
.Cells(x, 4).Value = oUser.displayName
.Cells(x, 5).Value = oUser.SamAccountName
.Cells(x, 6).Value = oUser.mail
.Cells(x, 7).Value = oUser.Description
.Cells(x, 8).Value = oUser.telephoneNumber
.Cells(x, 9).Value = oUser.Company
.Cells(x, 10).Value = oUser.Title
.Cells(x, 11).Value = oUser.department
x = x + 1
objRecordSet.MoveNext
Loop

End With

End Sub

Private Sub Workbook_Open()
LoadUserInfo
End Sub

как в ячейке перевернуть текст на 180 градусов?

на 90 градусов или КАРТИНКА ...
вроде ДРУГОГО нету ....

Gabzya
а похоже "по-честному" - никак... ;-(
Но, если текст нужен вверх ногами "чисто" для украшательства (т.е. потом не менять и не использовать в формулах его будет не надо), то можно сделать так:
выделить ячейку, Ctrl-Insert
потом нажимаете Shift и не отпуская его, открываете меню "Правка" -там появляется пункт "Вставить рисунок" = вставляете, потом крутите как угодно! ;-)

Gabzya
http://forum.ru-board.com/topic.cgi?forum=5&topic=23470&start=1440#21

у меня есть ссылка 'CN MKT'!AB133
как мне организовать ее поиск по всем листам?
как не бился - код дает ошибку
ссылка может быть в составе формулы
спасибо.

ol7ca
Вы не сказали куда девать результаты такого поиска. Приведенный пример просматривает ячейки с формулами на всех листах и формирует массив из адресов ячеек (с именем листа), содержащих в формуле искомый фрагмент. В данном примере будут найдены ячейки, содержащие в строке формулы слово "Лист". В коде подробные комментарии. Доработайте, как Вам нужно.

Код: Sub qq()
Dim i As Integer, F As Long, A() As String, myCell As Range
ReDim A(0) 'Массив из одного элемента
For i = 1 To ActiveWorkbook.Sheets.Count 'Цикл по всем листам
On Error Resume Next 'Если нет ячеек с формулами - продолжать
F = Sheets(i).Cells.SpecialCells(xlCellTypeFormulas).Count 'Поиск ячеек с формулами
If Err = 0 Then 'Если есть такие ячейки
For Each myCell In Sheets(i).Cells.SpecialCells(xlCellTypeFormulas)
'Если в строку формулы ячейки входит искомый фрагмент,
'то увеличиваем размерность массива и добавляем элемент массива,
'содержащий имя листа и адрес.
If InStr(1, myCell.Formula, "Лист") <> 0 Then 'Вместо "Лист" подставьте то, что надо найти
A(UBound(A)) = Sheets(i).Name & Chr(33) & myCell.Address
ReDim Preserve A(LBound(A) To UBound(A) + 1)
End If
Next
End If
On Error GoTo 0 'Возвращаем нормальную работу обработчика ошибок
Next
ReDim Preserve A(LBound(A) To UBound(A) - 1) 'Корректируем размерность массива

'Для контроля выведем поочередно сообщения о найденных ячейках
For i = LBound(A) To UBound(A)
MsgBox A(i)
Next
End Sub

SAS888

Цитата:

Вы не сказали куда девать результаты такого поиска.

забыл. сорри. мне надо чтобы найденная ячейка активировалась или как у вас был виден путь.
спасибо. я попрбую ваш код.

Добавлено:
SAS888

Цитата:

ReDim Preserve A(LBound(A) To UBound(A) - 1) 'Корректируем размерность массива

в этой строке мне дает ошибку Subscript out of range.
я пока не разобрался почему.

ol7ca
Алгоритм этой процедуры такой: объявляем массив из одного элемента, затем ищем в каждом листе, в ячейках, содержащих формулу, интересующий нас фрагмент. При обнаружении, записываем его в массив и увеличиваем размерность массива на 1 (подготовка к вводу следующего значения). Поэтому, при выходе из цикла, размерность массива оказывается на 1 больше, чем найденных значений (последний элемент - "пустой"). Для этого мы корректируем размерность, уменьшая на 1 (тест этого кода у меня проходит).
Совет такой: так как в коде включен перехват ошибок (который необходим на случай, если на листе не нашлось ни одной ячейки с формулой), то отладчик выдаст ее только после отключения перехвата ошибок, т.е. именно в этой строке. Скорее всего массив, по каким-то причинам, вообще не был сформирован. Поэтому, ошибка, возможно, происходит раньше. Проверьте правильность задания строки для поиска. В моем коде это
Цитата:

If InStr(1, myCell.Formula, "Лист") <> 0 Then

Вместо слова "Лист" нужно вставлять строку, соблюдая все правила ее формирования. Так, например, если нужно получить строку 'CN MKT'!AB133, то нужно записать так:
Код: Chr(39) & "CN MKT" & Chr(39) & "!AB133"

DocBeen

Цитата:

Хотелось бы реализовать по максимуму надстройку, включить в нее свои макросы и работать с любой книгой, вызывая их кнопками из этой надстройки...

Долго не отвечал, поскольку на работе был до ночи каждый день... DocBeen написал мне личное сообщение, а я предложил вынести обсуждение надстройки в тему, может кому ещё мой опыт пригодится.

Итак, создаём надстройку с макросами. Надстройка добавляет свои кнопки в панель инструментов... [more=Далее...]
1) Для простоты разработки и установки этого дополнения (AddIn), а также его отладки я создал его в качестве обычного файла Excel. Так что начинаем с того, что открываем новый файл Microsoft Excel и сохраняем его в папку с другими *.XLS - файлами. Это будет наш основной файл, с которым мы будем дальше работать. Дело в том, что надстройку *.XLA можно отредактировать (макросы), но сложно потом записать сделанные изменения. А редактировать данные на листах неудобно, поскольку все листы в загруженной надстройке не показываются.

2) Открываем VBA. Создаём новые модули с именами, например, Button_panel_management и Excell_menu_buttons. В первый мы добавим код для добавления, удаления кнопок с панели инструментов, а также функцию-проверку, что панель существует. Во второй модуль будем писать код макросов, которые вызываются при нажатии на наши кнопки.

В Button_panel_management:

Код: Public Const Bar_name As String = "My cool Bar" 'Название вашей панели с кнопками
Const temporary_bar As Boolean = False
Const Button1_pic = "Button_Pic1" ' Это внутренни имена объектов-картинок (см. далее).
Const Button2_pic = "Button_Pic2" ' Вы же хотите нарисовать свои рисунки
Const Button3_pic = "Button_Pic3" ' на них, не так ли?
' Ну и т.д. Для каждой кнопки своя картинка.

Доброго времени суток! поставлена передо мной следуящая задача: есть список адресов (около 10000), забит этот список в столбик на листе экселя. требуется распечатать каждый адрес на отдельм листе в определенном месте (для последующей рассылки в конвертах), так вот уже пару дней соображаю как все это организовать. сначала хотел сделать скрипт, что бы при нажатии кнопочки во второй лист, в определенную ячейку копировался адрес, потом выводилась печать, а потом все повторялось со следующей ячейчкай из списка, но потом до меня дошло, что принтер от такого безобразия может уйти в себя и не вернуться. теперь думаю как организовать все это в одной задачи на печать. буду рад выслушать ваши предложения по этому делу, т.к. мой мозк уже совсем сплавился... а времени как всегда все меньше и меньше.
заранее спасибо!

Цитата:

есть список адресов (около 10000), забит этот список в столбик на листе экселя. требуется распечатать каждый адрес на отдельм листе в определенном месте (для последующей рассылки в конвертах)

Я бы сделал шаблон в MS Word и посмотрел в сторону "Слияния" (MailMerge).
Единственный вопрос, как он себя поведет с документов 10 тыс. страниц.
Для ухода от этого, можно попробовать ограничить количество запрашиваемых записей из источника при вызове ThisDocument.MailMerge.OpenDataSource.

Natylay

Цитата:

Здравствуйте! помогите пожалуйста очень нужно!
Нужно создать табель учета рабочего времени в эксель, чтобы автоматически можно выбирать месяц и год, и даты заносились в готовый шаблон, в выделенные ячейки! причем все это делалось через форму, форма есть, проблемма с написанием процедуры!

Посмотрите шаблон моего табеля (за основу брал шаблон кого-не помню, хоть убей, табеля), делал под себя с большими мучениями и ошибками, но пользуюсь.

Извините, переписал, уж слишком откровенно (еще уволят ;(( )
Табель