» Excel VBA (часть 3)

Mishel917
Цитата:

Если у Вас мыши исправные, то срабатывание подряд двух событий не будет проявляться.

Так может просто мышь исправную приобрести?

Maximus777

Если для себя, то да. Для работы программы у пользователя необходимо такую ситуацию предусмотреть. У пользователя тоже есть неисправные мыши и он всегда прав.

Добавлено:
grbdv

В примере проводим Click по календарю на Page0. Допустим, мышь сгенерировала DbClick. События начали обрабатываться синхронно. Первый Click запустил обработку Calendar1_Click. MultiPage1 переворачивается с Page0 на Page1. В этот момент второй сгенерированный Click мыши запускает событие ListView1_MouseUp на Page1, в результате чего MultiPage1 переворачивается с Page1 на Page2. Таким образом, при ненадёжной работе левой кнопки мыши один Click запускает два события, и вместо Page1 получаем Page2.

Как заблокировать обработку второго события?

Mishel917

Цитата:

Допустим, мышь сгенерировала DbClick

События OnClick и OnDblClick (или как там в синтаксисе оригинала) - это разные вещи. Если "мышь сгенерировала DbClick", то именно это событие и будет обработано, а не два клика подряд.

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

Добавлено:
Я что хотел-то всем этим сказать? -
- какая бы ни была неисправная мышь (или что бы не хотел бы там юзер), все что с ней происходит будет однозначно интерпретировано системой как клик, даблклик, драг и последующий дроп или просто постановка фокуса. А каждое из этих событиефф будет обработано Екселем _последовательно_ - одно за другим.

Я же говорил - разложи стопами все возможные события ...
... и все поймешь, и все увидишь сам..

Mishel917

Цитата:

В примере проводим Click по календарю на Page0. Допустим, мышь сгенерировала DbClick. События начали обрабатываться синхронно. Первый Click запустил обработку Calendar1_Click. MultiPage1 переворачивается с Page0 на Page1. В этот момент второй сгенерированный Click мыши запускает событие ListView1_MouseUp на Page1, в результате чего MultiPage1 переворачивается с Page1 на Page2. Таким образом, при ненадёжной работе левой кнопки мыши один Click запускает два события, и вместо Page1 получаем Page2.

Как заблокировать обработку второго события?

Вобчем не открылись Ваши контролы у меня. Видимо разница версий библиотек. Ни ListView, ни Calendar не видны на форме. Пришлось делать вслепую. Предлагаю вот такой вариант решения задачи. Ну и чуть оптимизировал Ваш код, закомментив лишнее.

[more] grbdv

Добрый день!

Из всех событий для мыши на форме (UserForm_Click, UserForm_DblClick, UserForm_MouseDown, UserForm_MouseMove, UserForm_MouseUp) с помощью Stop установил, что срабатывают события - UserForm_MouseDown и UserForm_MouseMove.
UserForm_MouseMove не рассматриваем.

Для UserForm_MouseDown код

Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Calendar1_Click
End Sub

работает без сбоев, т. е. всегда открывается Page1, как и должно быть, дата на Лист не записывается

Cells(intJ, 1).Value = Calendar1.Value,

что естественно, так как дата не выбрана.

Похоже, что событие MouseDown стабильно обрабатывает одну процедуру, однако можно ли будет использовать этот факт при работе с календарём? В календаре для мыши два события - Calendar1_Click и Calendar1_DblClick. Как то так:

Private Sub Calendar1_Click()    
…
UserForm_MouseDown Button, Shift, X, Y
…
End Sub,

код работает, но могут срабатывать две процедуры.
С постановкой фокуса не работал.



Maximus777

Добрый день!


Функция

If cntmsec - timeGetTime < 1000 Then Exit Sub    
в процедуре ListView1_MouseUp блокирует обработку второй процедуры для Calendar1_Click – это хорошо.
Однако блокирует ListView1_MouseUp, когда с ListView1 работаем на Page1, так как теперь cntmsec – timeGetTime всегда меньше 1000.
[/more]

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

Maximus777

Смысла в таблице нет, создаются опции списков на Page1 и Page2.
Должно работать так:
1. Click по календарю – дата записывается на Лист и открывается Page1 с первым списком (ListView или ListBox).
2. Click по выбранной опции первого списка, открывается второй список на Page2.

При неисправной мыши после Click по календарю, открывается сразу второй список на Page2.

Необходимо чтобы открывался всего лишь первый список на Page1.

ОК, смысл ясен, поразминаю опилки на досуге. Хотя стоп! А почему решение, которое было предложено в предыдущем посте, не подходит? Там в функции клика по календарю запоминается время. Затем, если вдруг сработал второй клик, проверяется это время, если оно меньше секунды, то делаем выход из второй, ложно сработавшей, функции. Если вызов второй функции корректен, то разница во времени будет явно больше секунды и всё должно отработать. Где засада?

Да, если работать с ListView на Page1, то cntmsec – timeGetTime всегда меньше 1000 (эта разница с минусом), однако из процедуры выходит. Непонятно.
Если ещё добавить инструментов

Private Sub ListView1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
Stop
MsgBox (cntmsec - timeGetTime)
If cntmsec - timeGetTime < 1000 Then Exit Sub
…

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

Mishel917
Цитата:

Да, если работать с ListView на Page1, то cntmsec – timeGetTime всегда меньше 1000 (эта разница с минусом), однако из процедуры выходит.

Ой! Сорри! Неужели Вы не заметили подвох? Вот так надо:

Код: If timeGetTime - cntmsec < 1000 Then Exit Sub

[more] Работает без сбоев. Необходимо ещё отрегулировать 1000. Постепенно довёл до 300, хотя для пользователя достаточно 500.
Спасибо! Особенности – привлекается таймер, необходима настройка.

Испытывал метод не измерять, а наблюдать.


Dim intFlag As Integer, intJlag As Integer


Private Sub Calendar1_Click()
…
intJlag = 1
Me.MultiPage1.Value = 1
End Sub



Private Sub ListView1_MouseUp

If intFlag = 0 Then intJlag = 0

If intJlag = 1 Then
intFlag = 1
intJlag = 0
Exit Sub
End If

…

End Sub

Private Sub UserForm_Initialize()
intJlag = 0
intFlag = 0
End Sub

Пропускает 5% затяжных кликов, когда уже можно увидеть открывшуюся Page1.

Эксперименты над событиями мыши дают результат.
Для UserForm_MouseDown код

Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Calendar1_Click
End Sub

работает без сбоев, - всегда открывается Page1, как и должно быть, но MouseDown нет в календаре.
[/more]

Вот ещё такой вариант борьбы с глючными мышами. Красивый напрочь
Надеюсь контролы от Xtreme Вы уже зарегистрировали. А библу с Calendar я прилагаю, вдруг у Вас версия отличается.

Подскажите с таким вопросом
Есть юзерформ в ней текстбокс. В текстбокс вводится число типа 0123-01234-012 (цифры могут быть разными, нули могут быть. а могут и не быть)
После этого это число переносится на лист где с ним производится операция Данные/Текст по столбцам. Текст разносится, НО лидирующие нули если они есть Excel проглатывает, а они важны для дальнейших рассчетов.
Как победить эту беду?

JekG
При разборе подставлять спереди ' - апостроф. Но, тогда в ячейке будет текст, а не число.
Если же число цифр одинаково в сегментах - то можно загнать просто число, отформатировав соответствующие ячейки по типу "00000".

grbdv
Это я в инете нагуглил, но реализовать в макросе не сумел...
Вы пробовали так делать?

Вот код операции Данные/Текст по стобцам записанный макрорекордером. После этой команды выходят значения без нулей. Можете проверить у себя..


Код: Range("A2").Select
Selection.TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
TrailingMinusNumbers:=True

JekG
Я не ожидал, что "разбор" будет организован так примитивно :(
Эта ф-ция TextToColumns - мутная шняга, которая по своему усмотрению форматирует destination и имеет еще много разных побочных эффектов.

Пиши ручной разбор и будет щазтье :)

- вычислить все позиции разделителей (в данном случае "-")
- разобрать на сегменты хочешь строками, хочешь числами
- загнать в ячейки с учетом моего ответа выше

grbdv
Цитата:

Пиши ручной разбор и будет щазтье

Полностью солидарен с предложением.

[more] Maximus777

Спасибо за пример. Установил контролы от Xtreme. У Xtreme ListView лучше дизайн. Есть и ограничения, скопированные у ListView – обязательность наличия названий колонок для списка. Если на форме до 5-ти колонок, то во многих случаях можно обойтись без них. Панель с названиями колонок заваливает интерфейс. В Интернете много сообщений о том, что уязвимости модуля Codejock.Controls.v12.0.1.ocx привлекают внимание …

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

Таймер лучше CheckBox.

Код:

Dim binFlag As Boolean

Private Sub ListView1_MouseUp

If binFlag = False Then
binFlag = True
Exit Sub
End If
…
End If

Private Sub UserForm_Initialize()
binFlag = False
End Sub

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

Поможет класс

Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Calendar1_Click
End Sub,

который бы обладал свойствами UserForm_MouseDown и Calendar1_Click.
[/more]

JekG
Вот тебе парсер. [more=Допиливай...]

Код:
Sub sb_Parse()
Dim tDlm() As Byte, tPos As Byte, tLB As Byte, tUB As Byte, tBeg As Byte, tEnd As Byte, i As Byte
Dim sSrc$, sDlm$, sTgt$()
'sSrc = "012303456078"
sSrc = "0123-03456-078"
sDlm = "-"

tPos = 0
tBeg = 1
tLB = 1: tUB = 0

Do
tPos = InStr(tPos + 1, sSrc, sDlm)
Select Case tPos > 0
Case True
tUB = tUB + 1
tEnd = tPos - 1
ReDim Preserve tDlm(1 To 2, tLB To tUB)
tDlm(1, tUB) = tBeg
tDlm(2, tUB) = tEnd
tBeg = tPos + 1
Case False
Exit Do
End Select
Loop

Select Case tUB > 0
Case True
If tLB <> LBound(tDlm, 2) Or tUB <> UBound(tDlm, 2) Then Stop
tUB = tUB + 1
ReDim Preserve tDlm(1 To 2, tLB To tUB)
tDlm(1, tUB) = tDlm(2, tUB - 1) + 2
tDlm(2, tUB) = Len(sSrc)

For i = tLB To tUB
ReDim Preserve sTgt(i)
sTgt(i) = Mid(sSrc, tDlm(1, i), tDlm(2, i) - tDlm(1, i) + 1)
Debug.Print sTgt(i)
Next
Case False
Debug.Print "Nothing to parse..."
End Select
End Sub

p. s. Как Вам удаётся так красить форму?

Mishel917
Цитата:

p. s. Как Вам удаётся так красить форму?

Откройте для себя два замечательных свойства форм - Picture и PictureSizeMode. Если мне важен вес файла, то я делаю линию в один пиксель, с градиентной заливкой и тяну её на всю форму. Получается дёшево и сердито. Если вес не важен, то впяливаю картинку на всю форму.

По поводу заголовков ListView от Xtreme обратите внимание на его свойство HideColumnHeaders. По поводу уязвимостей хз, у меня в офисе несколько лет работает мега макрос (чуть ли не 1С) со всеми ихними контролами и никаких проблем.

Всем доброго времени суток!

Кодом:

ListView1.SelectedItem.Top
ListView1.SelectedItem.Height

в ListView1 можно определить значение свойств Top и Height для первой опции списка.

Вопрос, - каким кодом можно определить значения свойств Top и Height для заголовка столбцов?

ListView1.ColumnЗаголовок.Top


Добавлено:
Так не срабатывает

MsgBox ListView1.ColumnHeaders.Top

Добавлено:
Значение Width можно определить кодом

MsgBox ListView1.ColumnHeaders.Item(1).Width

Для Top не проходит.

Подскажите плз, в каком направлении двигаться, а-то чет в смятенни.
Задача вот какая.
Есть таблица (А), которая в своих расчетах использует исходные данные из таблицы (Б) и на базе расчетов из таблицы (А) формируются диаграммы и графики. И вот в чем проблема. Я задаю диапазон исходных данных в таблице (Б) т.е. от 1 до N и получается что мне необходимо сформировать N таблиц (А) и на базе их построить кучу графиков и диаграмм. Это криво и не удобно. Как можно решить данную проблему. что бы было так.
В исходной таблице (Б) я задал диапазон данных (от 1 ... N) и графики построились на одном листе для всего диапазона (1 ... N), но таблица (А) оставалась одна, т.к. расчет в ней верен для всего диапазона.
С VBA знаком, правда подзабыл уже(( Так что если направите в нужном направлении буду благодарен.

Mishel917
Цитата:

Вопрос, - каким кодом можно определить значения свойств Top и Height для заголовка столбцов?

ИМХА, здесь только с помощью WinAPI. Непонятно, зачем Вам это понадобилось ...

DoubleZero

Цитата:

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

Задача не совсем ясна. Может Вам просто навести порядок в таблице (Б)?

Maximus777

Добрый день!

Для
ListView1.HideColumnHeaders = False
или
ListView1.HideColumnHeaders = True

координата первой опции
ListView1.SelectedItem.Top
одинаковая.

Реально, при
ListView1.HideColumnHeaders = True
первая опция занимает место заголовка колонок и Top первой опции теперь равняется Top заголовку колонок. Таким образом, при ListView1.HideColumnHeaders = True необходимо переопределить координату первой опции. Эта координата равна Top заголовка колонок.


Добавлено:
Если для ColumnHeaders есть возможность определить значение Width

Dim oListColumnHead As Object
Set oListColumnHead = ListView1.ColumnHeaders.Item(1)
MsgBox oListColumnHead. Width

то возможно есть класс, в котором прописать

oListColumnHead. Top
oListColumnHead. Height

и таким образом получить значения Top и Height для заголовка столбцов.

Mishel917
Всё гораздо проще. Если у Вас заголовки скрываются программно, то просто проверяйте их статус, если скрыты, то переносите ListView выше и увеличивайте соответственно его Height.


Цитата:

Для
ListView1.HideColumnHeaders = False
или
ListView1.HideColumnHeaders = True

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

Maximus777

Координату ListView1.ColumnHeaders.Top и значение ListView1.ColumnHeaders.Height в тексте макроса задаю вручную. Эти величины можно измерять. Например, ListView1.ColumnHeaders.Top = 2,25; ListView1.ColumnHeaders. Height = 13,5. Имея эти значения переставлять ListView1 уже не надо. Но это настройка ручная. Лучше когда компьютер сам себя замеряет.

Не плохо бы продлить перечень методов и свойств

ListView1.ColumnHeaders
. Add
. Clear
. Count
. Item
. Remove

до
. Top
. Height

Полагаю, кто-то соберётся с силами и продлит этот список.


Добавлено:
Если нет

MsgBox ListView1.ColumnHeaders.Top
при ListView1.HideColumnHeaders = True, то заменой может быть

MsgBox ListView1.SelectedItem.Top - ListView1.SelectedItem.Height

Mishel917
Цитата:

MsgBox ListView1.SelectedItem.Top - ListView1.SelectedItem.Height

Попробуйте поиграть с ListView1.ListItems(1).Top - ListView1.Top.

Для ListView1.HideColumnHeaders = True или ListView1.HideColumnHeaders = False

MsgBox ListView1.ListItems(1).Top - ListView1.Top

возвращает одинаковое значение -30,5.
Должно быть - 2,25, если ListView1.HideColumnHeaders = True.

У меня на форме не один ListView1.

Mishel917
Сдаётся мне, самое приемлемое решение, это нарисовать заголовки и вставить их в Image. Когда надо, будете скрывать их, когда надо показывать снова. А в ListView выключить заколовки насовсем. Именно так мне и пришлось поступить, когда я захотел использовать PNG графику в окнах сообщений. Положил на форму три Image и делаю их видимыми в зависимости от ситуации. Вот одна из ситуаций (иконка Инфо и одна кнопка):