» Excel VBA (часть 2)

HarryG
Что-то вы здесь накрутили, codename проверяется в текущей книге, вместо вашей. Может так:

Код: Dim BottleRashod As Worksheet

Set BottleRashod = Workbooks(NameBookOstatki).Worksheets("БутылкаРасход")

If BottleRashod.CodeName = "" Then
MsgBox (Trim(BottleRashod.Index) + " : " + BottleRashod.CodeName)
End If

уважаемые спецы, может кто-нибудь помочь с макросом?

по заданному значению из в первого столбца (например "ЭН2") необходимо получить данные из последнего столбца соответствующих строк через запятую (например "108,57")

картинка таблицы
http://img230.imageshack.us/my.php?image=excelpa2.jpg

Masqqq
Основная часть [more=в виде функции]

Код:
Public Function NeedingFinder(ByVal inRange As Range, ByVal What As String) As String
Dim pRange As Range, sResult As String
Dim lastCol As Long, inCol As Range, wks As Worksheet
Dim rowOffset As Long, firstAddress As String

rowOffset = inRange.Row - 1&
lastCol = inRange.Columns.Count

Set wks = inRange.Parent
Set inCol = wks.Range(wks.Cells(inRange.Row, inRange.Column), _
wks.Cells(inRange.Rows.Count + rowOffset, inRange.Column))
Set pRange = inCol.Find(What, inCol.Cells(1&, 1&), XlFindLookIn.xlValues, _
XlLookAt.xlWhole, XlSearchOrder.xlByRows, _
XlSearchDirection.xlNext, False)

If Not pRange Is Nothing Then
firstAddress = pRange.Address
sResult = CStr(inRange.Cells(pRange.Row - rowOffset, lastCol).Value)
Set pRange = inCol.FindNext(pRange)
Do Until pRange.Address = firstAddress
sResult = sResult & "," & CStr(inRange.Cells(pRange.Row - rowOffset, lastCol).Value)
Set pRange = inCol.FindNext(pRange)
Loop
End If
NeedingFinder = sResult
End Function

AndVGri
пробую использовать Вашу функцию, не получается..
может я что-то не так делаю? помогите плиз разобраться

прилагаю файл с таблицей
Ссылка

Masqqq
Public Function ConcatColumn(Where As Range, Cond As String) As String
Dim r As Range, res As String, n As Integer

n = Where.Columns.Count
res = ""
For Each r In Where.Rows
If r.Cells(1, 1) = Cond Then res = res & ", " & r.Cells(1, n)
Next
ConcatColumn = Mid$(res, 3)
End Function

Использование: =ConcatColumn(A1:K13; "ЭН2")

2 nick7inc


Цитата:

Версия офиса какая? У меня оно не пустое получается:

Офис 2003

Проблема в том, что при закрытом Excek и соотвественно VBA по нажатию на кнопку вывадивается ошибка о поустом CodeName. Если запуск делать из VBA, то никакойц ошибки нет. По ссылке лежит книга с примером.

http://rapidshare.de/files/38478851/test.rar.html

panda3
снимаю шляпу!
спасибо большое...выручил

nick7inc
спасибо за предыдущие подсказки - все работает!

есть еще пару вопросов, если можно..
1. как скопировать таблицу из одного листа в другой и из одного файла в другой?
2. как скопировать лист одного файла в другой?
3. можно ли скопировать скрипт из одного файла в другой или можно в самом скрипте вставить текст того скрипта, который нужно вставить?
4. если я делаю одинаковую операцию для N листов, например эту:


Цитата:

'куда вставлять и сколько столбцов
' если один столбец
set r2=ws.columns(2)
' если несколько
set r2=ws.range(ws.columns(2),ws.columns(2+i-1))
' i - количество столбцов для вставки
Application.CutCopyMode = False ' чтобы случайно что-нибудь не скопировать,
' если была ранее операция копирования
r2.insert Shift:=xlToRight

как правильно это записать?

спасибо.

nick7inc
Да без скобок работает, спасибо я думал что только через Call работает...

Добавлено:
можно ли написать макрос открывающий файл под другим именем? ну т.е. открыть как??

Доброе время суток !

Помогите пожалуйста разобраться :

в VBA создаётся кнопка меню : (пример во вложении)
http://slil.ru/25435147

Код:
Dim pop As Office.CommandBarPopup
Dim btn As Office.CommandBarButton
Set pop = Application.CommandBars.Item("Worksheet Menu
bar").Controls.Add(msoControlPopup)
With pop
.Caption = "SAMPLE"
.Tag = "sample"
.BeginGroup = True
End With
Set btn = pop.Controls.Add(msoControlButton)
With btn
.Caption = "Function sample"
.Tag = "sample"
.OnAction = "sample"
' .OnAction = "sample(1)"
End With

HarryG

Цитата:

Проблема в том, что при закрытом Excek и соотвественно VBA по нажатию на кнопку...

Странно вы выражаетесь... Глюк, действительно, есть. Если закрыть редактор VBA, то при создании новой книги, а в ней - листа, то Codename листа недоступен. Попробую покрутить VBA, может что и получится.

Добавлено:
Всё, глюк сдался (по крайней мере он перестал воспроизводиться).
HarryG
Сначала небольшие замечания по коду+решение проблемы.
[more=далее]1) Вместо кода
Код: Workbooks.Add xlWBATWorksheet
[...]
Workbooks(NameBookOstatki).Activate
[...]
Set BottlePrihod = Worksheets.Add
' и в других местах, где добавляете лист в книгу

NovaC
Засунь параметр в .Parameter
Он же для этого и предназначен. В .Tag еще можно засунуть.
В функции sample получишь его через Application.CommandBars.ActionControl.Parameter

vasiliy74

Цитата:

можно ли написать макрос открывающий файл под другим именем

Вообще-то файл открывается по любому имени. Не понял я вопроса, что именно нужно открыть?

Добавлено:
ol7ca

Цитата:

1. как скопировать таблицу из одного листа в другой и из одного файла в другой?
2. как скопировать лист одного файла в другой?

Посмотрим в мой пример: Ссылка
Источник и приёмник определяются командами, например:

Код: Set r1 = ws.Range("B2:C5") ' Это источник
Set r2 = ws.Range("E6:F9") ' Это приёмник

nick7inc

Цитата:

Вообще-то файл открывается по любому имени. Не понял я вопроса, что именно нужно открыть?

Имя имеется ввиду права среды, например AD Windows типа открыть файл как другой пользователь.

Добавлено:
Ещё столкнулся с такой проблемой: в Excel установлен плагин с формулами, макрос при открытии запускает их как отследить программно что вычисление на листе все закончились? просто каждый раз время выполнения разной и хотелось бы запускать следующий автоматически после того как формулы из ADDins закончат свою работу.

nick7inc

спасибо за помощь!

vasiliy74

Цитата:

например AD Windows типа открыть файл как другой пользователь

Не знаю, разве что искать, как с помощью WinAPI это сделать.

подскажите, плз, есть ли каой-то способ, найти нужную комбинацию суммы чисел методом перебора слагаемых? Например, имеем 10 цифр, при сложении только некоторых из них получается результат Х. Вариантов ответов может быть 0 или 1 несколько. Количество слагаемых в разных случаях разное.

vasiliy74
Запуск программы через RunAs из Visual Basic посредством WinAPIСсылка.
На свой собственный страх и риск!

ol7ca

Цитата:

есть ли каой-то способ, найти нужную комбинацию суммы чисел методом перебора слагаемых?

да есть. Именно перебором. Причём сложность (в смысле число вычислений растёт очень сильно с ростом числа чисел, участвующих в переборе!!!)
а алгоритм перебора не простой, а очень простой ;-):
два слагаемых:
первое число + второе = x ? первое число + третье = x ? первое число + N = x ?
три слагаемых:
потом первое + второе + третье = ? первое + второе + четвёртое = X?
и т.д.
на каждом шаге число слагаемых увеличиваем на единицу...
по моему, так...

Задача - просмотр в форме таблицы из акцессовской базы данных. Реализация через ListBox не устраивает. Пытаюсь использовать Microsoft FlexGrid Control, но сталкиваюсь со следующей трудностью: не могу привязать поле DataSource к обекту recordset.
Set rs = db.OpenRecordset(SQLq)
Set MSFlexGrid1.DataSource = rs
Получаю ошибку "Object variable or With block variable not set"
Простое забивание значений с помощью AddItem проходит нормально, но это почти то же самое, что и использование ListBox.
Как привязать данные к этому контролу? Или, м.б., кто-нибудь предложит другой вариант?

gubo
Ты видимо используешь DAO для доступа, а MSFlex желает ADO
Вот так работает.

Код:
Dim pCon As New ADODB.Connection
Dim dbRec As New ADODB.Recordset

pCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source=d:\path\my.mdb"
dbRec.Open "Select * From MyTable;", pCon

Set MSFlexGrid1.DataSource = dbRec

AndVGri
Не помогает, ошибка та же. dbRec имеет тип RecordSet, а у MSFlexGrid1.DataSource какой-то iRowCursor. Пока не могу определить, что за зверь.

SERGE_BLIZNUK

а как это реализовать в виде скрипта?

подскажите, пожалуйста, где можно подробнее почитать о преобразовании текстовых и других файлов в эксель с помощью VBA.
и еще о том как можно использовать другие программы в качестве базы для получения данных в эксель с помощью VBA. если не ошибаюсь, за это отвечает функция DDE.

AndVGri
большое спасибо, с этим вариантом все получилось.

Привет.

Подскажите кто-нибудь, как в макросе отследить нажатие кнопки сейв?

Пасиб)

Hryun
Обрабатывать событие WorkbookBeforeSave объекта Application
gubo

Цитата:

Не помогает, ошибка та же. dbRec имеет тип RecordSet, а у MSFlexGrid1.DataSource какой-то iRowCursor. Пока не могу определить, что за зверь.

Ну, тогда не знаю. У меня работает. Может различия в версиях? DataSource у меня класс DataSource в msdatscr.tbl, он, видимо, поддерживает работу с ADODB.RecordSet

AndVGri
У меня такой:
msdatscr.tbl Microsoft Data Access - Data Source Interfaces 9.1.1117.0 (xpsp_sp2_rtm.040803-2158).
msflxgrd.ocx 6.0.84.18
Поиск в инете дал следующее: лучше пользоваться Microsoft Hierarchical FlexGrid Control (MSHFLXGD.OCX) Там вроде DataSource как раз имеет тип RecordSet. OCX я нашел, осталось найти информацию, как ему лицензию подсунуть, чтобы он работать начал, и проверить.
А можно увидеть твой рабочий пример, лучше всего файлом?

Добавлено:
AndVGri зарегистрировал Microsoft Hierarchical FlexGrid. С ним твой пример работает. Только выдает на экран только первую строку из таблицы, вне зависимости от того, сколько я определяю Rows.
Плюс ко всему при открытии экселем файла, где используется форма с FlexGrid, при старте выдается вот таоке сообщение "This application шs about to initialize ActiveX controls that might be unsafe. If you trust the source of this file, select OK and the controls will be initialized using you current workspace settings." Как от него избавиться?

gubo

Код:
dbRec.Open "Select * From MyTable;", pCon

error 2029 при работе с ячейкой в которой значение равно #NAME? ну или #ИМЯ? как сделать проверку и не обрабатывать значение? а то выполнение макроса прекращается.

vasiliy74

Код: Dim b as boolean
b = IsError(Лист1.Cells(1, 1))
if b then
msgbox "Дело пахнет керосином"
else
msgbox "Всё путём"
end if