» Excel VBA (часть 2)

Troitsky

Цитата:

ежели система русская, то и заголовок кнопки "ОК" в диалоге, скорее всего, в русском написании идет

Угу, иногда Copy/Paste спасает.

Немного не в тему, но больше нигде проблемы такой не нашел.

W2K3 в терминальном режиме. Офис 2003.
в папке c:\Program Files\Microsoft Office\OFFICE11\XLSTART\ лежит личная книга макросов (там для того что бы была доступна всем пользователям).

Проблема в следующем, если в книге которая использует макросы из personal.xls в Tools/References указать сслыку на personal.xls то при закрытии Excel, именно при закрытии Excel, а не при закрытии файла, он (Excel) вылетает с ошибкой в модуле vbe6.dll.
Убираем ссылку на personal.xls, все закрывается нормально.

В какую хоть сторону копать может кто подскажет ?

Подскажите, пожалуйста, где у меня ошибка - почему не заполняется диапазон "C15:C24" ведь стоит Range("C15:C24").Activate и какое тут правило?

Range("C15").Select
Selection.Copy
Range("C15:C24").Select
Range("e15").Select
Range("C15:C24").Activate
Range("e15").Activate
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

ol7ca
А проще не пробовал?

Код:
Range("C15").Copy
Range("C15:C24").PasteSpecial ....

Здравствуйте! Подскажите, пожалуйста, возможно ли с помощью VBA создать автономный программный модуль (т.е. модуль, не находящийся в книге Excel). Если да, то как?

Troitsky

Цитата:

Кстати, обрати внимание, что ежели система русская, то и заголовок кнопки "ОК" в диалоге, скорее всего, в русском написании идет, а, следовательно, при поиске окна с англоязычным заголовком, ты кнопку просто не найдешь - функция FindWindowEx будет ноль возвращать

Система не русская.
Handle находится, но SendMessage lhwnd_btn, BM_CLICK, 0, 0 в этом случае не срабатывает

Код в первом случае срабатывает без проблем
[more]
Private iCounter As Integer

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 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Const BM_CLICK = &HF5
Private Const WM_SETTEXT As Long = &HC&

Sub OkBtnClick()
Dim lhwnd As Long

Dim sClassName As String
Dim sCaption As String

sClassName = "#32770" ' window class
sCaption = "List Status" ' window title

' find required window
lhwnd = FindWindowEx(0, 0, sClassName, sCaption)

If lhwnd = 0 Then
iCounter = iCounter + 1
'Application.StatusBar = "not found at " & Now() & ": " & iCounter
If iCounter > 20 Then
iCounter = 0
Call cmdCancel
Exit Sub
End If
'Application.OnTime Now() + TimeValue("00:00:05"), "OkBtnClick"
Call Aux

Exit Sub
End If

sClassName = "Button" ' button class
sCaption = "OK" ' button title

' find required button in the window
lhwnd_btn = FindWindowEx(lhwnd, 0, sClassName, sCaption)

' send event BM_CLICK to the button
SendMessage lhwnd_btn, BM_CLICK, 0, 0

End Sub

Sub Aux()
Sleep 2000 '2 sec later
Call OkBtnClick
End Sub
[/more]

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


Добавлено:
tec4
как один из вариантов - ActiveX Dll (но в VB)

Вопрос тоже интересует, но занимался им пока поверхностно.
Послушаем, что эксперты скажут.
Я не программист.

P.S.: Или тебе что попроще хватит? Типа создания Add-Ina?

AndVGri

спасибо.

Я прошу прощения за, возможно, тупые вопросы - я новичёк

Подскажите еще, пожалуйста, сколько максимально можно вставить значений в одну строку :
Range( _
"C15:C24,C30:C81,C84,C89:C90,C97:C100,C103,C107:C116,C120,C124:C125,C131:C132,F135:F136,F10,P135:P136,P10" _
)
и если это уже максимум, то как добавить еще 10 раз по столько?

a также,

Range("C15").Copy
Range( _
"C15:C24,C30:C81,C84,C89:C90,C97:C100,C103,C107:C116,C120,C124:C125,C131:C132,F135:F136,F10,P135:P136,P10" _
).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("C15:C24").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub

этой операцией я хочу скопировать сначала формулы из другого файла (я потом укажу путь к файлу) а затем заменить формулы на значения. Но как короче записать вставку когда много формул?
я знаю только так:
Range("C15:C24").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

потому как

Range( _
"C15:C24,C30:C81,C84,C89:C90,C97:C100,C103,C107:C116,C120,C124:C125,C131:C132,F135:F136,F10,P135:P136,P10" _
).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

не работает

Olive77

Цитата:

Handle находится, но SendMessage lhwnd_btn, BM_CLICK, 0, 0 в этом случае не срабатывает

не в этом ли соль? цитата из MSDN:

Цитата:

If the button is in a dialog box and the dialog box is not active, the BM_CLICK message might fail. To ensure success in this situation, call the SetActiveWindow function to activate the dialog box before sending the BM_CLICK message to the button.

Добавлено:
На всякий случай, замечание к функции SetActiveWindow:
Цитата:

The SetActiveWindow function activates a window, but not if the application is in the background. The window will be brought into the foreground (top of Z order) if the application is in the foreground when it sets the activation.

If the window identified by the hWnd parameter was created by the calling thread, the active window status of the calling thread is set to hWnd. Otherwise, the active window status of the calling thread is set to NULL.

The SetForegroundWindow window function, on the other hand, activates a window and forces it into the foreground. An application should only call SetForegroundWindow if it needs to display critical errors or information that needs the user's immediate attention.

Добавлено:
На всякий же случай, можно попробовать глянуть в сторону WM_SETFOCUS


Добавлено:
Код выкладывать не буду. О результатах пиши.

Как правильно определить положение ячейки с которой начинается действие скрипта?

Мой скрипт правильно работает только когда курсор стоит в правильном месте:
Sheets("name").Select
Range("J14").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("J25").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("J30").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
...

ol7ca
Скопировать во множественный диапазон можно так

Код:
Public Sub SpecialCopy
Dim pUnion As Range
'Объединять можно до 30 аргументов в одном вызове Union
Set pUnion = Application.Union(Range("C15:C24"), Range("C30:C81"), Range("C90,C97"))
Set pUnion = Application.Union(pUnion, Range("C103"), Range("C107:C116"))
'...
Range("C15").Copy
pUnion.PasteSpecial ...
End Sub

Можно и попроще. Хоть как-нибудь. :)

tec4
Что конкретно нужно сделать и почему в отдельном файле? Кстати, для новичка, IMHO, лучше изучать макросы в той книге, к которой они применяются. Если надо обрабатывать несколько книг, то можно код сделать как в XLS-файле, так и в виде AddIn (что почти XLS-файл, только грузится автоматом при запуске программы и не показывает свои листы). Я программировал свои кнопки в панели инструмантов Excell, делал те функции, которые сильно облегчают мне теперь работу.

Добавлено:
Olive77

Цитата:

Handle находится, но SendMessage lhwnd_btn, BM_CLICK, 0, 0 в этом случае не срабатывает

1. Я где-то слышал, что надо посылать сообщение дважды, возможно при помощи сочетания разных функций SendMessage/PostMessage.
Выписка из файла-справки InqSoft Sign of Misery [more=далее]Команда посылает окну, хэндл которого хранится в переменной "Хэндл найденного окна", системное сообщение, которое интерпретируется большинством управляющих элементов Windows как клик мышью по этому элементу. Если в переменной "Хэндл найденного окна" хранится некорректное значение хэндла или по какой-либо причине не удалось отправить окну сообщение, откомпилированный скрипт выдаст сообщение об ошибке.

На практике эта команда обычно применяется для того, чтобы автоматически "нажимать" кнопки внутри NAG Screen'ов и вызывается после команд Найти дочернее окно по тексту в его заголовке и Найти дочернее окно по полному тексту его заголовка.

В некоторых случаях для того, чтобы "нажать" на кнопку, необходимо вызвать эту команду дважды.[/more].

2. Кроме поиска хендела окна также надо найти хендл кнопки, которой потом и посылается сообщение "нажать". Вы так и делаете или окну посылаете сообщение?

nick7inc

Программа автоматически заполняет listbox значениями из заданного столбца первой рабочей книги, по нажатии кнопки выбранное в listbox значение ищется в заданном столбце второй рабочей книги (книга открывается автоматически при нажатии той же кнопки); т.к. заданное значение может встречаться в столбце несколько раз, создан автофильтр. В принципе, задача выполнена.
Дело в том, что рабочая форма вызывается при нажатии заданного сочетания клавиш (при выполнении макроса) в первой рабочей книге, а это неудобно, т.к. в первой рабочей книге постоянно меняются (добавляются/удаляются) данные, т.е. база меняется. Вторая книга обновляется каждый месяц.
Поэтому хотелось бы создать независимый модуль.

Troitsky
Здорово!
SetActiveWindow в комбинации с SetForegroundWindow помогло.

Спасибо огромное.

AndVGri

спасибо.


Цитата:

Цитата:Как правильно определить положение ячейки с которой начинается действие скрипта?

Что значит в правильном месте? У тебя и так скрипт перед копированием и вставкой переходит в заданные ячейки по Range("xxyy").Select, начиная с ячейки J14

так вот он правильно работает только когда курсор стоит на J14.
то же самое происходит на других листах. там я так же определил положение начала копирования-вставки:
Sheets("name").Select
Range("xxyy").Select

мне приходится прежде ставить курсор на правильные места а затем запускать скрипт


Добавлено:
В данном случае все определено верно и где бы я ни находился - запускаю скрипт и все работает.
Что же все-таки нужно четко прописывать, чтобы скрипт начинал работать с правильной ячейки?

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


Sheets("NAME").Select
Range("H6").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=+[XXX.xls]X!RC"
Range("H6").Copy
Range( _
"H6,T6,AE6,AQ6,D10:D37,F10:F37,O10:O37,R10:R37,AA10:AA37,AC10:AC37,AM10:AM37,AO10:AO37,AM41:AM62,AO41:AO62,AM66:AM69,AO66:AO69,AM82,AO82,AM84:AM87,AO84:AO87,AM90:AM92,AO90:AO92,AM100:AM109,AO100:AO109,AM112,AO112,AQ114:AQ115,AE114:AE115" _
).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Union(Range( _
"R62,AA41:AA62,AC41:AC62,D66:D69,F66:F69,D82,F82,D84:D87,F84:F87,D90:D92,F90:F92,O66:O69,O82,O84:O87,O90:O92,R66:R69,R82,R84:R87,R90:R92,AA66:AA69,AC66:AC69,AC82,AA82,AA84:AA87,AC84:AC87,AA90:AA92,AC90:AC92,D100:D109,F100:F109,O100:O109,R100:R108,R109" _
), Range( _
"AA100:AA109,AC100:AC109,AA112,AC112,R112,O112,H115,H116,F112,D112,H6,T6,AE6,AQ6,D10:D37,F10:F37,O10:O37,R10:R37,AA10:AA37,AC10:AC37,AM10:AM37,AO10:AO37,AM41:AM62,AO41:AO62,AM66:AM69,AO66:AO69,AM82,AO82,AM84:AM87,AO84:AO87,AM90:AM92,AO90:AO92" _
), Range( _
"AM100:AM109,AO100:AO109,AM112,AO112,AQ114:AQ115,AE114:AE115,D41:D62,F41:F62,O41:O62,R41:R61" _
)).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range( _
"J10:J37,V10:V37,AG10:AG37,AS10:AS37,J41:J62,V41:V62,AG41:AG62,AS41:AS62,J100:J109,V100:V109,AG100:AG109,AS100:AS109,AS112,AG112,V112,J112" _
).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

End Sub

1. Как перехватить команду с помощью VBA (к примеру, команду в Excel “Параметры”)?
2. И как определить, что нажато ОК или Отмена?

Olive77

Цитата:

SetActiveWindow в комбинации с SetForegroundWindow помогло

Можно и без SetActiveWindow обойтись попробовать. У меня, например, такой код работает:
Код: 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 Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Const WM_SETFOCUS = &H7
Private Const BM_CLICK = &HF5

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

sClassName = "#32770" ' класс окна - диалог
sCaption = "Project1" ' заголовок окна
' Находим нужное окно
lhwnd = FindWindowEx(0, 0, sClassName, sCaption)
' делаем окно активным (выводим на передний план)
SetForegroundWindow lhwnd

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

Troitsky

Цитата:

Можно и без SetActiveWindow обойтись попробовать. У меня, например, такой код работает

ОК, завтра попробую.

Добавлено
Угу, все чики-чики.
Мерси.

AndVGri


Цитата:

Скопировать во множественный диапазон можно так

Как можно cкопировать множественный диапазон в него же (я хочу скопировать формулы и вставить значения)?

ol7ca
Так кто мешает?
pUnion.Copy
pUnion.PasteSpecial ...

И общая рекомендация совсем не обязательно выделять курсором ячейку для работы
Range("C1") или Cells(1, 3), например, вполне достаточно для внесения данных в ячейки (возможно с указанием рабочего листа Worksheets("Name").Range("C1"). Единственное требование для вставки требуется, чтобы лист на котором выполняется вставка был активным

tec4

Цитата:

Дело в том, что рабочая форма вызывается при нажатии заданного сочетания клавиш (при выполнении макроса) в первой рабочей книге, а это неудобно, т.к. в первой рабочей книге постоянно меняются (добавляются/удаляются) данные, т.е. база меняется.

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

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

1) Сделать 3й XLS-файл только с кодом и формами; он будет оперировать с обеими книгами. Например, у меня есть файл-шаблон, где я выбираю книгу и лист, с которыми работаю:


2) Можно сделать это аналогично п.1, только в виде AddIn'а. Код работы с данными будет тот же, диалог можно вызывать кнопкой из панели инструментов, грузить файл не надо, он будет сам стартовать при запуске Excell.

Добавлено:
AndVGri & ol7ca
Можно сделать через

Код:
Dim r as range, c as range
set r=range("A5:B10").cells 'Здесь задаётся обрабатываемый диапазон
for each c in r:c=c.value:next c

nick7inc

Большое спасибо! Попробую.

Подскажите пожалуйста. У меня есть Книга з двумя листами - "MENU" и "Eliminar". "MENU" содержит в столбце A код продукта (из цифр и букв) а в столбцах B, C, D....Z, данные продукта. А в "Eliminar" в столбец A записываю код продукта, который надо удалить из "MENU" вместе с данными( тоесть строки в которых Worksheets("MENU").Range("A:A")) соответствует данным из сриска Worksheets("Eliminar").Range("A:A"). Пытаюсь:
a) c имеющихся данных (Worksheets("Eliminar").Range("A:A")) содать массив
b) если (Worksheets("MENU").Range("A:A")) содержит элементы массива (точнее идентичны) , то содержимое ячейки заменить на "ZZZ"
c) позже сироки с содержимым "ZZZ" собераюсь удалить.
Просьба: пункт "b" у меня не получается, я думаю, понятно что я не столько разбераюсь в этом, сколько пытаюсь использовать примеры, и естественно разобратся. Искренне БЛАГОДАРЕН за любую помощь.

Код:

Sub ElCel_1()
Dim SheetNames() As Variant
Dim i As Integer
Dim SheetCount As Integer
Worksheets("Eliminar").Select
Range("A1").Select
Selection.EntireRow.Insert
SheetCount = Application.WorksheetFunction.CountA(Range("A:A"))
ReDim SheetNames(1 To SheetCount)
For i = 1 To SheetCount
SheetNames(i) = ActiveCell.Offset(1, 0)(i).Value
MsgBox SheetNames(i)
Next i
Worksheets("Eliminar").Select
Rows("1:1").Select
ActiveSheet.Rows("1:1").Delete
Call BubbleSort(SheetNames)
End Sub
________________________________
Private Sub BubbleSort(List() As Variant)

Dim i As Variant
Dim SheetCount As Variant
'
Worksheets("Eliminar").Select
SheetCount = Application.WorksheetFunction.CountA(Range("A:A"))
Sheets("MENU").Select
'
For i = 1 To SheetCount
For Each Cell In Range("A:A")
If Cell.Value Like List(i) Then
Cell.Value = "ZZZ"
End If
Nexti
End Sub

ЯЕсть Multipage на Userform в VBA. ПОдскажите пожалуйста как установить для каждого Page цвет ярлычка и фон такой же как и для Multipage в целом?

проблемка такая, беру из файла значение дата/время в unix формате (переменная типа Long) и ее необходимо преобразовать к удобоваримому виду, и воткнуть в ячейку. как можно красиво сделать преобразование?

Друзья,
Нужно "отрисовать" средствами VBA форму ТОРГ-12 (Товарная накладная).
Т.е.у меня есь массив данных в экранной форме VB6 в виде сетки.
Мне нужно выгрузить в EXCEL под форматирование в ТОРГ12.
В зависимости от количества строк в накладной разбить на страницы
и корректно перенести шапку.

ZORRO2005
Ну и в чём, собственно, проблема? Рисуй вручную пустой шаблон в Excell того, что хочешь получить. Шаблон храни в каком-нибудь файле, как только он нужен - кодом копируй его в нужную книгу и заполняй при нажатии на кнопку в форме. Так легче будет его в последствии править. Можно, конечно, его кодом рисовать, но это довольно-таки сложно и потом его поправить будет оч. проблематично.

А вообще - хотелось бы увидеть что уже у вас есть, хотя бы в виде картинок.

Добавлено:
GARRYGOR
Я поискал среди встроенных функций и не нашёл. Проще самому написать соотв. функцию. Нужно описание этого формата.

Добавлено:
robinLib
В лоб, по-видимому, сделать это нельзя, но есть обходной путь: [more=на английском]Re: Can a userform multipage backcolor be changed?

MultiPages and TabStrips do not have background color properties and cannot themselves be colored. Complaints should be directed to Redmond, Washington...I don't understand why Microsoft has not provided for this feature but they just have not, at least not up to and including Excel2003 (its latest version to date).

To color a multipage, here's a workaround:
Draw an image control over the page, then set its background color to whatever you want from Image control's BackColor property palette. Right-click on the Image control, and select "Send Backward".
Ссылка[/more]

Добавлено:
Вот максимум, что мне удалось сделать по приведённому выше описанию: Ссылка


Добавлено:
ferias
В каком месте кода у вас происходит поиск и замена по пунакту b) (или вы не сами знаете? )

Есть ячейка с ссылкой на другой лист "=Лист1!А1", как из VBA получить имя этого листа?

nick7inc
Я поискал среди встроенных функций и не нашёл. Проще самому написать соотв. функцию. Нужно описание этого формата.

unix формат дата/время это количество секунд с 1 января 1970 (long). Ладненько, преобразуем не стандартно.

Gavrik

Цитата:

Есть ячейка с ссылкой на другой лист "=Лист1!А1", как из VBA получить имя этого листа?

Можно при помощи стандартных операторов бейсика:
Instr()
Mid$()

Ищем начало, конец, а потом вырезаем нужную часть строки.
Добавлено:
Только не надо забывать, что восклицательный знак, по которому мы ищем, может быть частью имени: ='!A'!B2 Лучше поискать по '!, а если не найдено, то конец имени листа определяем по !. Или просто находим последный !.