» Excel VBA (часть 2)

Возможно ли заставить excel-ь с помощью VBA выполнять клиент-серверные операции между двумя приложениями excel?

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

К примеру переменая "test" имеет имеет значение "1 шт. - 3,00 м; & Chr(10) & 5 шт. - 1,75 м; & Chr(10) & 2 шт. - 5,20 м;", то если использовать "Debug.Print test" или "MsgBox test" получаем результат в три строки. Используя макрос "MyTestPutToClipBoard", получаем результат в одну строку. Возможно ли получить результат в три строки?

ferias
Вместо Chr(10) используйте Chr(13). И обратите внимание на расстановку кавычек.
Нужно, например, так:
"... " & Chr(13) & "..." & Chr(13) & "..."

SAS888
Спасибо большое за
Цитата:

Chr(13)

p.s.
Цитата:

обратите внимание на расстановку кавычек

пример писал не внимательно.

Уважаемые знатоки!

Подскажите, пожалуйста, как можно получить индекс элемента коллекции изнутри цикла For Each. Индекс нужен для удаления этого элемента через .Remove(index) Или может быть есть другие способы удаления этого текущего элемента?

То есть есть код:
For Each Element in MyColl

'здесь нужно удалить текущий элемент (Element) из коллекции
MyColl.Remove (???)

Next Element

JackUser
Можно
Dim test As Collection
Dim X as integer
DIM I as integer

x = test.Count

For I= X to 1 Step -1
test.remove(I)
Next I

или

Do While test.Count > 0
test.Remove (1)
Loop

или, чтобы удалить сразу все элементы

Set test = Nothing

Цитата:

или, чтобы удалить сразу все элементы
Set test = Nothing

Это не верно. Данной строкой вы присваиваите переменной test значение Nothing, т.е. вы освобождаете её, а не удаляете все элементы коллекции.
Например коллекция Charts вполне останется на листе после этой команды

dneprcomp, спасибо за ответ!!!

Очень элегантный вариант решения!

Ранее, от кода For I= 1 to X пришлось отказаться именно изза ошибки, связанной с удалением объекта и несовпадением I и test.Count. Думал, можно сделать только через For Each.

Код работает, но все равно есть проблема: если удалить сразу два элемента, будет ошибка. Что можно сделать с этим?

x = test.Count
For I= X to 1 Step -1
test.remove(I)
test.remove(I-1)
Next I

Возможно, все таки придется делать через For Each. Но тогда надо как-то удалять элемент по индексу...

JackUser
а зачем делать цикл удаления всех элементов коллекции, а потом пытаться всунуть ещё такую строку
test.remove(I-1) ??? - которая пытается за один проход удалить не один а сразу два элемента???
Они и так все будут удалены!
Несуразица

visual73, спасибо за Ваше внимание к проблеме!

Дело в том, что есть процедура1, которая обрабатывает элементы коллекции.

Одновременно с этой процедурой1 работает процедура2, которая пересматривает все элементы коллекции, и, по заданному условию их удаляет. Связанные с адресацией при удалении проблемы этой процедуры решаются кодом For I= X to 1 Step -1, так как за раз она удаляет не более одного элемента.

Но в случае, если во время выполнения процедуры1, наша процедура2 успеет выполниться два раза, и удалить два элемента, то в процедуре1 возникнет ошибка, так как test.Count уменьшится сразу на два.

При использовании For Each в процедуре1 эта проблема решалась бы и ошибки не возникало. Но проблема в том, что эта процедура1 при обработке должна передавать ИНДЕКС элемента, а как его получить я не знаю!

В .net в контейнерах есть соответствующий функционал, а вот тут не знаю как...

JackUser
1. а что за коллекция? конкретнее..

2. Как может процедура (он же макрос), выполняться одновременно с другой процедурой??

3. У вас вложенный цикл, например For...For...Next..Next, да ещё и во внутреннем цикле удаляется элемент коллекции.. ? так?

Всем спасибо за помощь. Проблема решена введением счетчика в For Each.

JackUser
ну вот и славненько
Любая задача очень легко решается, если её объяснить так, чтобы самому понятно было

visual73

Цитата:

Например коллекция Charts вполне останется на листе после этой команды

Так это смотря какая коллекция. Объекты на листе конечно остануться. Для виртуальной - существующей только в памяти - все сработает.

может кто-то помочь почистить файл:
- показать все рабочие листы
- снять защиту с ячеек и листов
в общем чтобы можно было посмотреть и изменить структуру

http://rapidshare.de/files/48388241/KORADO_AJ.rar.html
Workbook password: [TVBCXWYRPXMIPPT]
Sheet 1 password: [TVBCXWYRPXMIPPT]
Sheet 2 password: [TVBCXWYRPXMIPPT]
VBA Project password: [39JL]

p.s. желательно закомментировать строки с пояснением для чего они

Solenaja
http://rapidshare.de/files/48390189/KORADO_AJ_un2.rar.html
закоментировал 1. авто_оупен для книги - разбираться не стал, что зачем.
2. все строки с Protect листов
3. Worksheet_SelectionChange

хелп) задача тупая но надо срочно)
обращаемся в файл по имени, залезаем в лист
ищем первую пустую ячейку в столбце А и записываем всю переданную строку

InSe0F
не особо понятно, в какой лист "залезаем" и откуда берём переданную строку...
вот, как вариант:

Код:
Sub InsertStrToColumnA()
Dim FirstEmptyRow As Long, w1 As Worksheet

Set w1 = Workbooks("ТестоваяКнига.xls").Worksheets("Лист1")
If IsEmpty(w1.Cells(1, "A")) Then
FirstEmptyRow = 1
Else
FirstEmptyRow = w1.UsedRange.Columns(1).SpecialCells(xlCellTypeBlanks).Cells(1).Row
End If
'MsgBox "First Empty in Column A = " & Str(FirstEmptyRow)
w1.Cells(FirstEmptyRow, "A") = "Тут Ваша переданная строка"
End Sub

написал

Код:
Sub InsertToDB()
Dim FirstEmptyRow As Long, DB_Workbook As Worksheet
Dim save_range As Range, cur_range As Range
Set save_range = ActiveSheet.Range("B3:B27")
Set DB_Workbook = Workbooks("filename.xls").Worksheets(1)
If IsEmpty(DB_Workbook.Cells(1, "A")) Then
FirstEmptyRow = 1
Else
FirstEmptyRow = DB_Workbook.UsedRange.Columns(1).SpecialCells(xlCellTypeBlanks).Cells(1).Row
End If

Set cur_range = Range(Cells(FirstEmptyRow, "A"), Cells(FirstEmptyRow, "Y"))
cur_range = save_range

MsgBox "First Empty in Column A = " & Str(FirstEmptyRow)

End Sub

InSe0F

Цитата:

Set DB_Workbook = Workbooks("filename.xls").Worksheets(1)

в данном случае книга должна быть открыта к этому моменту!
Это так?


Цитата:

cur_range = save_range

а разве так можно!? o_O тем более, что Вы хотите столбец записать в строку!!!!

SERGE_BLIZNUK
неа, просто сделать open?

Суть в том что скрипт вызывается из одного файла, а записывать должен данные в другой
причем специальной вставкой с трансформацией в первую пустую строку
мб через Copy просто сделать?
я уже путаюсь тут во всем)


Добавлено:
FirstEmptyRow = DB_Workbook.UsedRange.Columns(1).SpecialCells(xlCellTypeBlanks).Cells(1).Row
эта штука чет тоже не пашет(( а как ячейки скопировать до сих пор не ясно

Добавлено:
наврал - с открытой работает
в общем сделал через specialpastle вроде работает) пойдеть
всем пасиба

Можно ли сделать так, чтобы если выделен один или несколько столбцов и вызвано стандартное окно поиска Ctrl+F изменить умолчальные параметры в нем: Просматривать "По строкам" на "По столбцам", область поиска "формулы" на "значения".
Или как вариант добавить кнопку и на нее навесить макрос поиска по столбцу с вышеуказанными параметрами.

Попробовал через автозапись макроса:
Код: Selection.Find(What:=" ", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False).Activate

monsoon
как изменить параметры в стандартном окне поиска, я не знаю. (можно попытаться через SendKeys(...) — но имхо это не самый лучший путь).
А можно нарисовать свою форму поиска и вызывать её. А там уже расставить нужные параметры (или даже без параметров - просто искать по столбцам значения...

...
Цитата:

Можно попробовать сделать так: запомнить текущую ячейку, узнать значение следующей в столбце,...

а это я вообще не понял.. А зачем этот извилистый путь?

Мне кажется, что Вашу задачу решает простенький макрос вида:

Код: Sub MyFind()
Dim MyText4Find As String
Dim iRange As Range
MyText4Find = InputBox("Введите строку для поиска")
Set iRange = ActiveSheet.UsedRange.Find(what:=MyText4Find, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False)
If iRange Is Nothing Then
MsgBox "Текст " & MyText4Find & " на текущем листе не найден!", vbExclamation, "Ошибка"
' Exit Sub
Else
iRange.Activate
End If
End Sub

SERGE_BLIZNUK
Спасибо за пример.

Цитата:

А зачем этот извилистый путь?

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

Цитата:

область поиска можно изменять

В моем случае больше вроде подходит ActiveCell.EntireColumn

Еще вопрос, если не найдено выдается сообщение, что текст не найден, нажимаю "OK", появляется сообщение об ошибке "Code execution has been interrupted". При входе в Debug остановка на строке с "End If". Строку с "Exit Sub" раскомментировал, удалял - все равно выскакивает?

Цитата:

Правда еще нужно после этого как-то вызвать стандартное окно поиска.

попробуйте через SendKeys


Цитата:

Но все равно похоже без дополнительного хоткея или кнопки не обойтись никак.

похоже на то!


Цитата:

Еще вопрос, если не найдено выдается сообщение, что текст не найден, нажимаю "OK", появляется сообщение об ошибке "Code execution has been interrupted". При входе в Debug остановка на строке с "End If". Строку с "Exit Sub" раскомментировал, удалял - все равно выскакивает?

нет, у меня такого нет!
Excel какой? Макрос меняли?
попробуйте выложить пример в котором это наблюдается (запакуйте и на любой файл-обменник, ifolder, rapidshare, zalil.ru и т.п., сюда на форум ссылку на скачивание),
и опишите последовательность действий - на какую ячейку становитесь, вызываете макрос, что вводите, после чего возникает ошибка?...

visual73
спасибо более менее можно работать

SERGE_BLIZNUK
Интересно, попробовал на простеньких xls-файлах, отрабатывает без ошибок.
Excel 2000 (9.0.6926 SP3)

Файл
хоткей для вызова макроса Ctrl+я
Например, находимся в ячейке C650, д.б. текущей при открытии, вызываем макрос и ищем "максимус" (значение соседней ячейки справа). Появляется сообщение "Текст максимус в текущем столбце не найден!" Нажимаем "Ok", появляется сообщение об ошибке "Code execution has been interrupted".
Хм... попробовал с данным файлом в Excel 2003 (11.6355.6360) SP1 - отрабатывает без ошибок.

подскажите как:
- запретить доступ к скрытым листам книги, кроме активного листа (кроме пароля)
- не было ярлыков листов, но даже если пользователь сделал видимымый ярлык активного листа, в меню ярлыка не было возможности "Отобразить", "Скрыть" и т.д. другие листы

Sub СкрытьЯрлычкиЛистов()
ActiveWindow.DisplayWorkbookTabs = False
ActiveWindow.DisplayHorizontalScrollBar = False
ActiveWindow.DisplayHeadings = False
End Sub

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

Solenaja

Sheets(2).Visible = xlSheetVeryHidden 'режим Очень скрытный - лист не виден в окне "Отобразить"
ActiveWindow.DisplayWorkbookTabs = False 'спрятали закладки
ActiveWorkbook.Protect Structure:=True, Windows:=False 'защитили структуру

Через меню параметров можно вернуть панель ярлыков листов. Вряд ли как то можно заблокировать это действие.

visual73
а если понадобится вернуть назад - поменять на True / False?

можешь написать полностью как будет выглядеть макрос:
поставить пароль на все листы, на все листы кроме первого, например "Первый", поставить суперскрытый
Sub superprotect()
Dim PWORD As String
PWORD = "xxxxx"
ActiveWorkbook.Protect Structure:=True, Windows:=False 'защитили структуру
For Each WkSht In Worksheets
WkSht.Protect Password:=PWORD, AllowFormattingRows:=True
WkSht.EnableSelection = xlUnlockedCells
Sheets(2).Visible = xlSheetVeryHidden
ActiveWindow.DisplayHorizontalScrollBar = False
ActiveWindow.DisplayVerticalScrollBar = False
ActiveWindow.DisplayHeadings = False
Next WkSht
End Sub

но что-то ругается на макрос