» Excel VBA (часть 3)

V4mp

Код: Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Sub UserForm_Initialize()
Dim hForm As Long
hForm = FindWindow("ThunderDFrame", Caption)
SetWindowLong hForm, -16, &H92CE6A80
End Sub

vlth
Ага, переприменяем стили. Спс!
..
Такс.. Пишет Form already displayed; can't show modally (Error 400) - это если свойство showmodal=true.
Если ставить в false, то в панели задач не появляется иконки формы.
Может, ошибка в константе &H92CE6A80 ??
Или подскажи, где найти список констант стилей для vba, а то что-то на msdn не нахожу(

Цитата:

Такс.. Пишет Form already displayed; can't show modally (Error 400) - это если свойство showmodal=true.
Если ставить в false, то в панели задач не появляется иконки формы

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

Цитата:

Или подскажи, где найти список констант стилей для vba

Надо порыться по винтам: где-то был файлик. Но того, чего Вы хотите, там всё равно нет.

Когда-то искал такую возможность сам, но не нашёл. Может быт Вы будете удачливее?

Цитата:

Когда-то искал такую возможность сам, но не нашёл. Может быт Вы будете удачливее?

так все работает как я хочу даже при выскакивании ошибки 400. Формочка сворачивается в панель задач отдельно по кнопке свернуть, все ок. Едниственное - это ошибка эта...
msdn пишет на ошибку -

Цитата:

You tried to use Show, with the style argument set to 1 vbModal, on an already visible form.

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

Только заметил - ошибка стопорит дальнейшее выполнение кода (в частности UserForm_Activate), так что простое игнорирование ошибки не поможет...

1. В новой книге создаю форму.
2. Меняю свойство формы ShowModal на False
3. Вставляю представленный код
4. Жму кнопку "F5"

Форма появляется на экране со всеми описанными возможностями. Ошибки 400 нет.
Как она возникает?

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

ЕСТЬ!!! (свойство формы ShowModal на False)

Код:
---модуль----
Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal WindowStyles As Long) As Long
Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As _
Long, ByVal nCmdShow As Long) As Long


Enum WindowStyles
WS_OVERLAPPED = &H0
WS_POPUP = &H80000000
WS_CHILD = &H40000000
WS_MINIMIZE = &H20000000
WS_VISIBLE = &H10000000
WS_DISABLED = &H8000000
WS_CLIPSIBLINGS = &H4000000
WS_CLIPCHILDREN = &H2000000
WS_MAXIMIZE = &H1000000
WS_BORDER = &H800000
WS_DLGFRAME = &H400000
WS_VSCROLL = &H200000
WS_HSCROLL = &H100000
WS_SYSMENU = &H80000
WS_THICKFRAME = &H40000
WS_GROUP = &H20000
WS_TABSTOP = &H10000
WS_MINIMIZEBOX = &H20000
WS_MAXIMIZEBOX = &H10000
WS_CAPTION = WS_BORDER Or WS_DLGFRAME
WS_TILED = WS_OVERLAPPED
WS_ICONIC = WS_MINIMIZE
WS_SIZEBOX = WS_THICKFRAME
WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
WS_TILEDWINDOW = WS_OVERLAPPEDWINDOW
WS_POPUPWINDOW = WS_POPUP Or WS_BORDER Or WS_SYSMENU
WS_CHILDWINDOW = WS_CHILD
End Enum
----форма-----
Private Sub UserForm_Initialize()
Dim hForm As Long
hForm = FindWindow("ThunderDFrame", Me.Caption)
SetWindowLong hForm, -16, WS_CAPTION + WS_SYSMENU + WS_MINIMIZEBOX + WS_OVERLAPPED + WS_VISIBLE
ShowWindow hForm, 10
End Sub

И я нашёл...
Form_Style_1
Form_Style_2

Добавлено:

Цитата:

Странно, а какой у вас эксэль? у меня 2007 без обновлений, может поэтому...

Проект работал и в 2003 и в 2007 без обновления. Насчёт 2002 - не помню.
У меня сейчас - 2003.

Добавлено:

Цитата:

Проверьте мой код, возможности у вашего кода те же?

Всё то же самое, но невозможно изменить мышкой размеры формы.

Уточню - у меня Excel 2003 SP3

Добавлено:
Вот ещё забыл: у меня VBA стал ругаться на вызовы API, объявленные как публичные.

Не знаю я уже... в панель задач то сворачивается (кнопка есть) , но попутно возле ПУСКА появляется мини окошко (заголовок формы с кнопками свернуть, развернуть и выход), когда окно свернуто.... КАК его убрать, я чего то не понимаю(

Цитата:

но попутно возле ПУСКА появляется мини окошко (заголовок формы с кнопками свернуть, развернуть и выход), когда окно свернуто....

У меня только оно всегда и было - в панели задач никогда ничего не возникало (окно Excel у меня в проекте невидимо - на экране светится только форма).

Не.... Вот скриншоты (у мну так работает, если использовать код, выложенный мной выше)
Это при несвернутой форме

А это при свернутой -


И все бы хорошо, но ерундовина возле пуска портит всю картину((

В приведенном коде после его копирования удалите зачеркнутое + WS_VISIBLE. Может не удалили просто

Добавлено:
вроде нашел решение (форма нормально сворачивается в панель задач и рядом с пуском ничего нет)


Код:
----код модуля----
Option Explicit

Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal WindowStyles As Long) As Long
Private Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As _
Long, ByVal nCmdShow As Long) As Long


Enum WindowStyles
WS_OVERLAPPED = &H0
WS_POPUP = &H80000000
WS_CHILD = &H40000000
WS_MINIMIZE = &H20000000
WS_VISIBLE = &H10000000
WS_DISABLED = &H8000000
WS_CLIPSIBLINGS = &H4000000
WS_CLIPCHILDREN = &H2000000
WS_MAXIMIZE = &H1000000
WS_BORDER = &H800000
WS_DLGFRAME = &H400000
WS_VSCROLL = &H200000
WS_HSCROLL = &H100000
WS_SYSMENU = &H80000
WS_THICKFRAME = &H40000
WS_GROUP = &H20000
WS_TABSTOP = &H10000
WS_MINIMIZEBOX = &H20000
WS_MAXIMIZEBOX = &H10000
WS_CAPTION = WS_BORDER Or WS_DLGFRAME
WS_TILED = WS_OVERLAPPED
WS_ICONIC = WS_MINIMIZE
WS_SIZEBOX = WS_THICKFRAME
WS_OVERLAPPEDWINDOW = WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
WS_TILEDWINDOW = WS_OVERLAPPEDWINDOW
WS_POPUPWINDOW = WS_POPUP Or WS_BORDER Or WS_SYSMENU
WS_CHILDWINDOW = WS_CHILD
End Enum

Public Sub ssub()
Dim hForm As Long
hForm = FindWindow("ThunderDFrame", UserForm1.Caption)
DoEvents
SetWindowLong hForm, -16, WS_CAPTION + WS_SYSMENU + WS_MINIMIZEBOX
DoEvents
ShowWindow hForm, 1
DoEvents
End Sub

Sub qwe()
Application.Visible = False
Call UserForm1.UserForm_Initialize
End Sub

----код формы ----
Option Explicit

Private Sub UserForm_Activate()
MsgBox "UserForm_Activate"
End Sub

Public Sub UserForm_Initialize()
Call ssub
End Sub

Класс. Это то, чего мне лет пять назад не хватило терпения добиться. Осталось только иконку поменять с екселёвской на свою (где-то у меня лежит пример... вот где?)


Добавлено:

Цитата:

В приведенном коде после его копирования удалите зачеркнутое + WS_VISIBLE. Может не удалили просто

Не удалял: думал завтра поэкспериментировать

V4mp

Цитата:

Цитата:А что, при работе Формы(макроса) можно свернуть Excel???
Можно, если форма не модальная.

Пардон: а что такое не модальная форма?

И еще вопрос не по теме: если вы так пытаетесь убрать Excel и оставить только форму, может имеет смысл написать все это в VB?

фишка в том, что FindWindow инициализирует форму, даже если она пока не запущена. поэтому можно сделать вообще просто -

Код:
----код модуля----
Option Explicit

Private Declare ...
....
....End Enum

Sub qwe()
Dim hForm As Long
Application.Visible = False
hForm = FindWindow("ThunderDFrame", UserForm1.Caption)
SetWindowLong hForm, -16, WS_CAPTION + WS_SYSMENU + WS_MINIMIZEBOX
ShowWindow hForm, 1
End Sub

----код формы ----
Option Explicit

Private Sub UserForm_Activate()
MsgBox "UserForm_Activate"
End Sub

Private Sub UserForm_Initialize()
MsgBox "UserForm_Initialize"
End Sub

Цитата:

Осталось только иконку поменять с екселёвской на свою...

Код: Option Explicit

Declare Function GetActiveWindow32 Lib "USER32" Alias _
"GetActiveWindow" () As Integer

Declare Function SendMessage32 Lib "USER32" Alias _
"SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long

Declare Function ExtractIcon32 Lib "SHELL32.DLL" Alias _
"ExtractIconA" (ByVal hInst As Long, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long

'modification of code from Excel Experts E-Letter Archives.
'Original code By Jim Rech can be found by following this
'link > http://www.j-walk.com/ss/excel/eee/eee020.txt

Sub ChangeApplicationIcon()

Dim Icon&

'*****Change Icon To Suit*******
Const NewIcon$ = "notepad.exe"
'*****************************

Icon = ExtractIcon32(0, NewIcon, 0)
SendMessage32 GetActiveWindow32(), &H80, 1, Icon '< 1 = big Icon
SendMessage32 GetActiveWindow32(), &H80, 0, Icon '< 0 = small Icon

End Sub

vlth

За иконку спс!
GetActiveWindow32 получает hwnd активного окна. Может возникнуть гипотетическая ситуация, когда окно, в котором будем менять иконку, не будет активным. Думаю, в SendMessage32 лучше явно указывать hwnd формы, полученный нами ранее.

Кстати - уже добьем код окончательно, формочка то запускается изначально по координатам 0,0. Чтобы запускалась по центру -
добавляем объявление-

Код:
Private Declare Function GetSystemMetrics _
Lib "user32" (ByVal nIndex As Long) As Long

Добрый день,
Обращаюсь с просьбой помочь. Может кто подскажет - проблема вот в чем:Каждый день получаю по почте экселевский файлик с номерами заказов (они разбиты на два диапазона по типам) и каждый день надо копировать значения этих диапазонов в один столбец. Ну например есть:
диап.1 = G2:G25; диап.2= E27:E39 надо вставить в C2:С25 и С27:С39, для меня трудность, сделать макрос, заключается в том , что кол-во строк в диапазонах каждый день разная.
Может кто поможет новичку, буду очень благодарен.

timsyk
Цитата:

Может кто поможет новичку, буду очень благодарен.

Кнопка F1, свойства диапазона End и CurrentRegion, например.

Учитесь пользоваться в VBA помощью и отладчиком (пошаговое выполнение макросов - кнопка F8)

В конечном итоге Вам надо создать конструкцию:
ЧтоКопируем Copy КудаКопируем

Цитата:

ЧтоКопируем Copy КудаКопируем

ИМХО не стоит сразу человека подсаживать на порочную практику использования буфера обмена там, где и без нее обойтись можно Пусть лучше сразу привыкает писать такие макросы, чтобы у юзверей потом не было гневных воплей "я скопировала одно, а из-за ВАШЕЙ программки вставилось другое!"

timsyk
не понятно, что у Вас до и после диапазона, если Вы можете програмно идентифицировать начало и конец диапазона, то начинать копировать надо после выполнения условия начало, и соответственно до условия конца данных.

Первый диапазон: текст " Тип заказа 1" (G1)далее номера заказов, после пустые строки
Второй: текст "Дата поставки"(Е1)далее пустые строки до Е25, далее текст "Тип заказа 2", номера заказов , после опять тишина.
Как я уже сказал, проблема, что диапазоны каждый день разные по размеру, бывает когда второй вообще отсутствует. Тупо копировать надоело. Ладно буду сам разбираться. Спасибо за помощь. ( Правда спасибо, безо всякого подтекста).

Здравствуйте!

Есть список:


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



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

Заранее большое спасибо!

как проще всего реализовать механизм преобразования формул суммирования вычитания строк?
например запись в ячейке =А1+А2-А3 преобразвываем как запись в ячейке 1+2-3
или =SUM(А1:А3) преобразовываем как 1+2+3 и т.п.

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

Код:
Sub qwe()
Dim lRow As Long
Dim lCol As Long
Dim l1 As Long
Dim l2 As Long
lRow = ActiveCell.Row
lCol = ActiveCell.Column
'определяем последнюю заполненную ячейку l2
For l1 = lRow + 1 To 65000 '65000 - макс кол-во допустимых строк например
If Cells(l1, lCol) <> "" Then
l2 = l1
End If
Next l1
For l1 = lRow + 1 To l2
If Cells(l1, lCol) = "" Then
Cells(l1, lCol) = Cells(l1 - 1, lCol)
End If
Next l1
End Sub

2 V4mp: Большое спасибо, прекрасно работает!

Только он останавливается на последнем значении, и получается, что продлены все, кроме него. Как можно описать, чтобы он последнее значение продлевал вниз до конца (ну, там до 65000 ячейки)?

DANYA198
я думал, что последняя строка у вас итог там какой нибудь..
тогда так-

Код:
Sub qwe()
Dim lRow As Long
Dim lCol As Long
Dim l1 As Long
lRow = ActiveCell.Row
lCol = ActiveCell.Column
For l1 = lRow + 1 To 500 '500 - макс кол-во допустимых строк например
If Cells(l1, lCol) = "" Then
Cells(l1, lCol) = Cells(l1 - 1, lCol)
End If
Next l1
End Sub

timsyk
Должен сработать следующий код

Код:
Sub prog()
Dim l1 As Long
Dim l2 As Long

l1 = 1
Do While (Cells(l1, 7) <> "Тип заказа 1")
l1 = l1 + 1
Loop

Do While (Cells(l1, 7) <> "")
l1 = l1 + 1
Cells(l1, 3) = Cells(l1, 7)
Loop

l2 = l1

Do While ((Cells(l2, 5) <> "Тип заказа 2") And (l2 < 65000))
l2 = l2 + 1
Loop

Do While (Cells(l2, 5) <> "")
l2 = l2 + 1
Cells(l2, 3) = Cells(l2, 5)
Loop

End Sub

V4mp
Спасибище!

V4mp
Цитата:

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

Хмм... Откуда такое предположение, что VBA-форма может быть по отношению к каким-то окнам модальной, к каким-то - нет? - У меня в голове сложилось, что модальность формы неизбирательна по отношению к объектам: т.е. либо она модальная глобально в пределах приложения, либо (опять же глобально) - нет.

А что мешает просто, без API, по нажатию кнопки на форме 1 вызвать форму 2 (UserForm2.Show)?

vlth
наверное плохо объяснился.
если excel скрыт, и формочка (1) открыта (без разницы, модальная или нет по отношению к эксэлю), ТО:
1 - открываем модальную формочку (2) с формочки (1), например, по нажатию кнопки
2 - видим что форма (2) стала модальной только поверх формочки (1)
3 - нажимаем кнопку в виндовс "свернуть все окна"
4/1 - переключаемся на форму нажатием пункта в панели задач - итог - теряется фокус с формы (2)
4/2 - переключаемся на форму сочетанием клавиш alt-tab - итог - фокус с формы (2) не теряется.

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

DANYA198
Пожалуйста)