» Excel VBA (часть 2)

august23
на одно событие похоже не получится повесится...
вот набор событий, который покрывает вашу задачу, только прийдётся мудрить, если вам макрос нельзя вызывать повторно...
Private Sub Workbook_Open()
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Private Sub Workbook_NewSheet(ByVal Sh As Object)

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

И ещё, я не знаю, что за удобство в "рисует линии от активной ячейки до координатной сетки" - не представляю как это выглядит, но, лично я бы ОЧЕНЬ не хотел бы иметь такой макрос работающем на моём компьютере - т.к. он будет мне что-то рисовать вне зависимости от того надо оно мне или нет... не любли, когда компьютерная программа считает, что она лучше знает, что пользователю надо!!!

Это не моя разработка, хотя я давно хотел сам такое слепить

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
a = Target.Row
b = Target.Column
с = Target.Address
Cells.Borders(xlDiagonalDown).LineStyle = xlNone
Cells.Borders(xlDiagonalUp).LineStyle = xlNone
Cells.Borders(xlEdgeLeft).LineStyle = xlNone
Cells.Borders(xlEdgeTop).LineStyle = xlNone
Cells.Borders(xlEdgeBottom).LineStyle = xlNone
Cells.Borders(xlEdgeRight).LineStyle = xlNone
Cells.Borders(xlInsideVertical).LineStyle = xlNone
Cells.Borders(xlInsideHorizontal).LineStyle = xlNone
With Columns(b).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 3
End With
Columns(b).Borders(xlInsideHorizontal).LineStyle = xlNone
With Rows(a).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 3
End With
Rows(a).Borders(xlEdgeRight).LineStyle = xlNone
End Sub

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

august23
1) забудьте мой предыдущий совет насчёт событий, который нужно обрабатывать!
Здесь нужно совершенно другое - вам нужно найти код, построенный по вирусному принципу - т.е. который записывает нужный макрос во все открываемые листы. (причём, желательно с проверкой - что там уже есть макрос на SelectionChange...)

2) мне макрос АБСОЛЮТНО не понравился ;-(((( ничего особенно удобного не вижу.

3) макрос попросту вреден! Неужели у вас нет документов, которые оформлены как таблицы - выделены очертаниями шапка, столбы? Так вот, это макрос все установленные вручную границы (border) ячеек стирает!!!

4)
Цитата:

И не мне здесь рассказывать, что макрос можно приостановить

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

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

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

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

august23
Можно попробовать реализовать с циклом в каком-нибудь файле или AddIn'е:

Код:
public stop_cycle as boolean
public is_run as boolean

Sub Cycle
if is_run then exit sub
is_run=true
Dim v as variant


do until stop_cycle
v=Selection
Select case typename(v)

'[...]

end select
DoEvents
loop
stop_cycle=false
is_run=false
end sub

Sub StopC
stop_cycle=true
end sub

Цитата:

SERGE_BLIZNUK

Цитата:

два вопроса -
1) в таблицах B и C строго по три столбца с значениями?
2) наименования в B и C точно всегда совпадают? Количество, написание, порядок???

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

Привет, форумчане! Помогите плиз умным советом. Задача вообщем-то простая:
несколько операторов одновременно заводят документы каждый в своем файле. Каждому документу должен быть присвоен ID (сквозная нумерация). Для этого на сервере создан файл Excel, назовем его Num. И когда оператор заведя данные в форму нажимает ОК, программа открывает Num ,в ячейку А1 вносит следующий порядковый номер и закрывает его. Если в этот момент к файлу обращаются несколько пользователей, то происходит проверка открыт ли файл только для чтения и тем у кого для чтения сообщает "Документ не зарегистрирован. Попробуйте еще раз". И все бы ничего, но.... когда процедурой Workbooks.Open открывается файл, а он в это время занят другим пользователем, то имитируется нажатие кнопки Уведомить. Поэтому когда файл закрывается - другому пользователю приходит сообщение, что Файл стал доступным, Чтение и запись.
Разные варианты перепробовал, чтобы это обойти - пока не выходит. Хотелось бы, чтобы никаких подобных сообщений оператор не получал. Во-первых, чтобы не раздражало все время да и чтобы не нажал че-нить не то. Возможно ли это с Excel или придется делать в Access?

genter
Workbooks.Open Filename:=ThisWorkbook.Path & "/" & "test.xls", notify:=False
пойдет?

Experts
несколько посложнее вопрос
пытаюсь расковырять одну надстройку (Add-in), чтобы автоматизировать некие действия.
в этой надстройке используются .ocx файлы, которые, по-видимому, содержат диалоговые окна.

Диалоговое окно - самого простого вида:
TextBox - куда вносится адрес области
и две кнопки OK и Cancel.

Можно ли с помощью VBA нажать на "OK" или "Cancel"?
В свойствах элемента ничего не нашел, но может не там искал.
С .ocx-элементами никакого опыта нет

Мож кто чего почитать посоветует?

Olive77

Цитата:

Диалоговое окно - самого простого вида:
TextBox - куда вносится адрес области
и две кнопки OK и Cancel.

Странно, что это реализовано через OCX. Вполне модно сделать средствами самого VBA.

Добавлено:
Точно нет этого диалога среди UserForm's AddIn'а?

Добавлено:
Может эта форма внедрена в качестве одного из листов проекта, а листы в режиме AddIn'а не показываются...

Цитата:

Странно, что это реализовано через OCX. Вполне модно сделать средствами самого VBA.

Хозяин - барин.
Скрывают чего-то.


Цитата:

Точно нет этого диалога среди UserForm's AddIn'а?

Точно нет. Зуб даю.

в проекте сделана ссылка на этот .ocx файл.
за счет этого возможно определение переменной myList
Public myList As CSDList

далее
Sub test()

Set myList = New CSDList

With myList
Set .XLApplication = ThisWorkbook.Application
Call .ShowListForm(Selection.Address)
End With

End Sub

Командой Call .ShowListForm(Selection.Address) эта форма и вызывается.

Приветствую всех в этом форуме!

У меня необычная проблема, которая как раз под стать знатокам Exel:

Есть Google Exel sheet, он совместим с нормальным Exel, но имеет ограничения: в частности, не имеет VBA. Но зато есть формулы и их можно использовать на 100%. Вопрос в том как с помощью Exel встроенных формул сделать такое условие:

1. Если A1 >= 0, то цвет фона этой ячейки зеленый
2. Если A1 < 0, то цвет фона этой ячейки красный

Очень бы хотелось услышать варианты решения этой проблемы, а то бъюсь уже 2 дня (Кстати, решение через Conditional Formatting не прокатит, там нет этого option 8-( )

Может уже было... Как проверить нажата ли определенная клавиша?

golyshkin

Цитата:

как с помощью Exel встроенных формул сделать такое условие:

1. Если A1 >= 0, то цвет фона этой ячейки зеленый
2. Если A1 < 0, то цвет фона этой ячейки красный

В родном Excel есть такая штука, как условное форматирование.

CMD
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
If GetAsyncKeyState(vbKeyF8) < 0 Then

... etc

Olive77
Чтобы нажать кнопку надо как-то управлять событиями окон. Как это делается через VBA я точно не знаю. Но знаю, что есть интересная штука фирмы InqSoft, называется Sign 0f Misery. Там на псевдоязыке можно сделать програмку, которая ищет окно по какому-то признаку, находит кнопку и посылает ей команду "нажать". Можно там поучиться основам обработки событий, а потом найти где-то в сети описание для VBA или сделать немного иначе: написать на мистерии свою програмку по поиску окна и нажатию кнопки, скомпилировать в EXE и из VBA этот файл запускать. Довольно мороченный способ, но вполне реализуемый.

Добавлено:
Olive77

Цитата:

Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Не работает. Что-то пропущено или неправильно.

Добавлено:
Всё, нашёл в чём дело, Public не везде можно использовать.

Добавлено:
Olive77
Поиск окна при помощи WinAPI Советую обратить внимание на GetLastActivePopup на этом же сайте.
Вот здесь написано что-то про отправку сообщений (не вчитывался).

Добавлено:
Ещё поиск окна (?)

Olive77
Если окно создано в VB, то код приблизительно такой:
Код: Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const BM_CLICK = &HF5

Sub BtnClick()
Dim lhwnd As Long
Dim sClassName As String
Dim sCaption As String

sClassName = "ThunderRT6FormDC" ' класс окна
sCaption = "MyDialog" ' заголовок окна
' Находим нужное окно
lhwnd = FindWindowEx(0, 0, sClassName, sCaption)
sClassName = "ThunderRT6CommandButton" ' класс кнопки
sCaption = "OK" ' заголовок кнопки
' Находим нужную кнопку в найденном окне
lhwnd = FindWindowEx(lhwnd, 0, sClassName, sCaption)
' Посылаем кнопке событие BM_CLICK
SendMessage lhwnd, BM_CLICK, 0, 0
End Sub

Доброе время суток.
Ситуация следущая:
Есть макрос который при запуске выполняет некоторые преобразования с определённым листом из книги отправлеят этот лист на печать, сохраняет и закрывает файл. Всё замечательно, жмёшь открыть файл->выпонить макрос - всё работает. НО таких файлов в папке не один десяток, и даже иногда не одна сотня(((
Вопрос: как всё это автоматизировать?
Проблема в том что в выше описанном макросе везде используется ActiveWorkbook, так как имена файлов заранее неизвестны.
И я в том случае не понимаю как задать переменную - ведь это каждый раз разный файл, и как задать массив из файлов в директории, используя цикл:
For Each переменная In массив
Next
???

CMD

Цитата:

Может уже было... Как проверить нажата ли определенная клавиша?

Смотря где нажата. Если на пользовательской форме или на одном из ее элементов, то использовать всякие KeyDown, KeyPress, KeyUp (исходя из целей). Если нажатие нужно отловить вне формы, то, видимо, нужно ставить хук.


Добавлено:
InsomniaVK

Цитата:

каждый раз разный файл, и как задать массив из файлов в директории

Ну, если все эти файлы, работу над которыми предстоит проделать, находятся в одной дирректории, то проще, наверное, будет в цикле использовать VB функцию Dir.

выдержка из справки:
Цитата:

Синтаксис

Dir[(путь[, атрибуты])]

<...>

Дополнительные сведения

Функция Dir поддерживает использование подстановочных знаков для нескольких символов (*) и для одиночного символа (?) для указания нескольких файлов.
При первом вызове функции Dir необходимо указать путь, в противном случае возникает ошибка. Если указаны атрибуты файла, наличие аргумента путь является обязательным.

Функция Dir возвращает первое имя файла, имя которого удовлетворяет аргументу путь. Для получения остальных файлов, имена которых удовлетворяют указанному пути, следует повторно вызвать функцию Dir без аргументов. Если файлов, имена которых удовлетворяют указанному пути, не осталось, возвращается пустая строка ("").

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

For Each Dir("D:\111") In ***

' действия с файлом

Next Dir

тогда как определить массив ***??
или Dir это и есть массив?? хотя у Вас написано:

Цитата:

Функция Dir возвращает первое имя файла

пробовал:

Folder = Dir("D:\111")

For Each File In Folder

' действия с файлом

Next File

Выдаёт ошибку 13
Или лучше использовать другой цикл, то какой?

nick7inc
Troitsky
спасибо за подсказки. попробую.

Troitsky

Цитата:

Если окно создано в VB, то код приблизительно такой:

черт его знает в чем он создан, только начал копать, но не похоже, что в VB.


InsomniaVK
н-р,

Name1 = Dir(strPath & "*.xls")
Do While Name1 <> ""

Loop

etc...



Цитата:

Цитата:как с помощью Exel встроенных формул сделать такое условие:
1. Если A1 >= 0, то цвет фона этой ячейки зеленый
2. Если A1 < 0, то цвет фона этой ячейки красный

В родном Excel есть такая штука, как условное форматирование.

при условии, что условного форматирования нет (conditional formatting), можно, я думаю, отформатировать через
Format->Cells->Numbers->UDF (user-defined)

C Exelем опыта никакого нет

Olive77


Цитата:

Workbooks.Open Filename:=ThisWorkbook.Path & "/" & "test.xls", notify:=False
пойдет?

Я так уже пробовал - не пойдет, потому как в этом случае пользователь все равно получает сообщение, что файл зарезервирован пользователем.... Открыть для чтения/Отмена.
Ладно спасибо, я уже понял, что эту задачу надо решать не в Excel, а хотя бы в Access, где встроен счетчик. Для каждой задачи надо применять свое - универсального продукта не существует.

genter
ну, а почему бы тебе сначала не определить, открыт файл или нет

Код:
Function IsFileOpen(filename As String) As Boolean
Dim filenum As Integer, errnum As Integer

On Error Resume Next ' Turn error checking off.
filenum = FreeFile() ' Get a free file number.
' Attempt to open the file and lock it.
Open filename For Input Lock Read As #filenum
Close filenum ' Close the file.
errnum = Err ' Save the error number that occurred.
On Error GoTo 0 ' Turn error checking back on.

' Check to see which error occurred.
Select Case errnum

' No error occurred.
' File is NOT already open by another user.
Case 0
IsFileOpen = False

' Error number for "Permission Denied."
' File is already opened by another user.
Case 70
IsFileOpen = True

' Another error occurred.
Case Else
Error errnum
End Select

End Function

Troitsky

Цитата:

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ...

Спасибо за код. Нужная вещь

Добавлено:
Troitsky

Цитата:

Уточнить классы можно, например, с помощью Spy++, которая входит в Microsoft Visual Studio Tools.

Совсем не обязательно ставить Microsoft Visual Studio Tools для этой цели. Подойдёт бесплатная програмка InqSoft Window Scanner (Ссылка). Там, кстати, можно попробовать поотправлять разные сообщения для всевозможных интерфейсных элементов.

хотя здесь эта тема неоднократно поднималась, всё равно, думаю, информация будет полезна. Поэтому позволю себе украсть чужой пост Pavel55 с форума forum.developing.ru
цитирую

---

Вот этой теме (в середине) товарищ KL (XL) (Microsoft MVP) описывает плюсы и минусы разных методик нахождения последней строки:
http://www.sql.ru/forum/actualthread.aspx?tid=463148#4535898

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

Код: Sub Поиск()
Dim FoneFindSp, Fone As Range

Set Fone = Worksheets(1).Columns(2)
Set FoneFindSp = Worksheets(2).Columns(1)

For Each FoneCell In Fone
Set FoneSp = FoneFindSp.Find(FoneCell.Value)
If Not FoneSp Is Nothing Then
FoneCell.Offset(0, 5).Value = FoneSp.Offset(0, 1).Value
End If
Next FoneCell
MsgBox ("Конец")
End Sub

YFred
Set Fone = Worksheets(1).Columns(2).Cells

Olive77
Теперь в цикле обходит ячейки, но командой Find не чего не находит

YFred

Цитата:

For Each FoneCell In Fone

идёт обработка всех ячеек обоих столбцов, непонятно зачем...
Добавлено:
Надо добавить:

Код: Dim FoneCell as Range

nick7inc и Olive77

Может еще чо подскажите???? В чем ошибка?

Цитата:

Имеем файл А - куда должны попасть даные из файлов В и С. Важно чтобы были вставлены только значения без формул а итоговые (последняя строка снизу и последний столбец справа) остались с формулами. спасибо.

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