| |
|
|
| | почему то не все события доступны
кто как боролся? :) | |
| |
| |
| |
|
|
| | Минута обсуждения истекла.
1:0 в пользу телезрителя.
ps. СилЫч, а по-проще вопроса нет? :) | |
| |
| |
|
|
|
|
| |
|
|
| | а ты им скрой Аксовские прибамбасы (оставть только своё), а на формах напиши Ё-ксель  | |
| |
| |
| |
|
|
| | тогда головняк начнецца у меня когда пользователи будут кричать,ч то у них не работает (по причине того,что нет аксесса) 
а оно мне надо? | |
| |
| |
| |
|
|
| | ты ж всё могешь - подмени стандартные вопли своими
или сделай анализ из скрипта - в которое - если нет акса просит установить данный тобой дистрибутив и в тихаря тулит акс ни у кого не спрашивя после чего успешно работает | |
| |
| |
| |
|
|
| | После обновления
можно так сделать
в ненужной (скрытой) ячейке
=функция(ссылка на нужную ячеку) | |
| |
| |
| |
|
|
| | странное происходит
реализовал, типа таймер, на форме экселя
если запускаем форму, которая запускает другую форму с таймером, через функцию - таймер работает
если запускаем форму, которая запускает другую форму с таймером, через пункт меню - таймер не работает
гыгынуха какая то, а не Excel
Option Explicit
Public isCancel%
Public ParentFormName$
Dim rs As ADODB.Recordset
Dim timer_enabled As Boolean
Dim timer_interval As Double
Dim phWnd&
Private Sub btnCancel_Click()
If Err = 0 Then
If MsgBox("Прерывание может занять несколько минут" & vbNewLine & _
"Вы действительно хотите прервать выполнение запроса к серверу?" _
, vbYesNo, "Подтвердите") = vbNo Then Exit Sub
End If
isCancel = 1
timer_Stop
Me.Hide
DoEvents
End Sub
Private Sub UserForm_Activate()
On Error GoTo err123
Dim ff As Object
isCancel = 0
If Len(nz(ParentFormName, "")) = 0 Then
MsgBox "Неверно переданы параметры" & vbCrLf & iDevelop
GoTo errTerm
End If
For Each ff In VBA.Global.UserForms
If ff.name = ParentFormName Then Exit For
Next
If ff Is Nothing Then GoTo errTerm
Set rs = ff.oTray
If rs.State = adStateClosed Then GoTo errTerm
Me.txtTimeOf = Format(Abs(Time()), "Long Time")
phWnd = initBar(20)
Call timer_Start(TimeValue("00:00:01"))
Exit Sub
err123:
MsgBox Error & vbCrLf & iDevelop
errTerm:
Call timer_Stop: isCancel = 0: Unload Me
Exit Sub
End Sub
Private Sub UserForm_Initialize()
'хз
End Sub
Public Sub Timer_OnTimer()
Call Timer
If timer_enabled Then Call timer_Start
End Sub
Public Sub Timer()
On Error Resume Next
Dim tt
Static i%
tt = Format(Abs(Time()), "Long Time")
Me.txtTimeOf = tt
i = i + 1: updateBar i
If i > 20 Then clearBar phWnd: initBar 20: i = 1
If conn.State = 0 Then
MsgBox "Сервер прервал сессию"
Call btnCancel_Click
Exit Sub
End If
Select Case rs.State
Case adStateClosed '0 Indicates that the object is closed.
Me.capInfo.caption = "Закрыт:"
Me.capInfo.ForeColor = RGB(255, 0, 0)
MsgBox "Запрос закрыт со стороны сервера " & iDevelop
Call timer_Stop: isCancel = 0: Me.Hide
Exit Sub
Case adStateOpen '1 Indicates that the object is open.
Me.capInfo.caption = "Выполнен:"
Call timer_Stop: isCancel = 0: Me.Hide
Exit Sub
Case adStateConnecting '2 Indicates that the object is connecting.
Me.capInfo.caption = "Подключен:"
Case adStateExecuting '4 Indicates that the object is executing a command.
Me.capInfo.caption = "Выполняется:"
Case adStateFetching '8 Indicates that the rows of the object are being retrieved.
Me.capInfo.caption = "Выгружается:"
End Select
If Err = 0 Then Exit Sub
err123:
MsgBox Error & vbCrLf & iDevelop, , "Timer"
Call btnCancel_Click
Exit Sub
End Sub
Sub timer_Start(Optional ByVal interval As Double)
If interval > 0 Then timer_interval = interval
timer_enabled = True
If timer_interval > 0 Then Application.OnTime (Now + timer_interval), "RunOnTimer" 'процедура в модуле. запускает Timer_OnTimer
End Sub
Sub timer_Stop()
timer_enabled = False
Application.EnableCancelKey = 0 'отключаем прерывание
clearBar phWnd
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
MsgBox "Закрытие этой формы возможно только при нажатии на кнопку 'Прервать'", , iMsgErr
Cancel = True
End If
End Sub
Private Sub UserForm_Terminate()
isCancel = 0
clearBar phWnd
SetStatus
End Sub
|
| |
| |
| |
| |
|
|
| | наверное какая то херня с таймерами
может не отменяются? | |
| |
| |
| |
|
|
| | нашел в чем собака порылась
ну не дебилы, а?
видитили два раза функция из меню вызывалась, потому что в ней параметр передавался!
пришлось параметр прятать в Tag
все заработало
спасибо
ну всмысли не все, но мы ищем решения, проблем солвинг, млять
чтобы я еще когда нибудь сел за баранку этого пылесоса?!  | |
| |
| |
| |
|
|
| | Лучша(Pure) подписаться на события контролов коммандбара.
Правда, библиотека нужна офисная. | |
| |
| |
| |
|
|
| | какэто сделать? я создал класс соответсвующего контола
приколбасил его события в форме
часть событий ёсть, часть - псу под хвост!
это как понимать?
иликак вынимать, а? :)  | |
| |
| |
| |
 11 Кб. |
|
| | Примерный текст модуля класса для небольших панелек с известным числом контролов:
Private WithEvents cbb1 As Office.CommandBarButton
Private WithEvents cbb2 As Office.CommandBarButton
Private cb As Office.CommandBar
Private Sub cbb1_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
MsgBox Ctrl.Caption
End Sub
Private Sub cbb2_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
MsgBox Ctrl.Caption
End Sub
Private Sub Class_Initialize() ' или класса формы
Set cb = CommandBars.Add("My", , , True)
With cb
Set cbb1 = .Controls.Add(1, , , , True)
With cbb1
.Caption = "First"
.Parameter = "1st"
.FaceId = 71
End With
Set cbb2 = .Controls.Add(1, , , , True)
With cbb2
.Caption = "Second"
.Parameter = "2nd"
.FaceId = 72
End With
.Visible = True
End With
End Sub
Private Sub Class_Terminate() ' или класса формы
Set cbb1 = Nothing
Set cbb2 = Nothing
cb.Delete
Set cb = Nothing
End Sub
|
Кстати, офисная библиотека в Excel-е подключена дефолтно.
Или я не о том сейчас? :) | |
| |
| |
| |
7 Кб. |
|
| | WithOut UserForm =>
:) | |
| |
| |
| |
|
|
| | да, прикольно выглядит, но не надоть нам этого :)
а по поводу текста выше - не с коммандбарами проблема :)) а с контролами, которые на юзерформе
или это я не то? %)
вот создал класс(все как сказал о Великий Гугль :)
Option Explicit
Public WithEvents oTxtBox As MSForms.TextBox 'создаем элемент с отслеживанием его событий
'за назначение с отслеживанием событий отвечает оператор WithEvents
'(может применяться только в модулях классов)
'это событие не происходит вообще , так же как и After_Update и Before_Update
Private Sub oTxtBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
End Sub
Private Sub oTxtBox_Change()
On Error GoTo err123
Static OldValue As String
'If Not IsNumeric(oTxtBox.Text) Then
' oTxtBox.Text = OldValue
' oTxtBox.SelStart = Len(OldValue)
'Else
' OldValue = oTxtBox.Text
'End If
Exit Sub
err123:
MsgBox Error, , "ValidateEdit #" & Err
Exit Sub
End Sub
Private Sub oTxtBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error GoTo err123
Dim frm As MSForms.UserForm, vl
If KeyCode = 13 Then 'pressed Enter
End If
Exit Sub
err123:
MsgBox Error, , "ValidateEdit #" & Err
Exit Sub
End Sub
Private Sub oTxtBox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'-- установить селектор
'.Picture = getPicByFaceID(2945)
End Sub
|
дальше
'Создаем массив, размерность которого должна быть не менее кол-ва всех элементов события которых мы хотим отслеживать
'Объявляем переменную как НОВЫЙ(созданный нами) КЛАСС - As New clsTxtBoxs - это обязательно
'Данные переменные обязательно должны располагаться в общем модуле и быть глобальными
Public aTxtBox(1 To 255) As New clsTxtBoxs
|
еще дальше
Set txtBox = Me.Controls("grpSubForm").Add("Forms.TextBox.1", "txtValue" & i, True)
With txtBox
.Text = elm.Attributes(1).nodeValue
.Left = Me.lblValue.Left
.Top = topOffset
.Height = Me.lblValue.Height
.Width = Me.lblValue.Width
.BackStyle = fmBackStyleOpaque
.BorderStyle = fmBorderStyleNone
.TextAlign = fmTextAlignLeft
.SpecialEffect = fmSpecialEffectEtched
Set aTxtBox(i).oTxtBox = Me.Controls("txtValue" & i) 'прицепились к событиям
'но они не все :(
'а если создать контрол статический, то там события все что надо :/
End With
|
стало быть выход какой может быть?
говоришь, создать один контрол статический скрытый и пихать ему значение и проверять там по уму?
з.ы. еще раз говорю - очень ограничен в рамках поставленной задачи: инструмент - только то, что есть в Экселе, без дополнительных эктивиксов(особенно платных) :) ну и по времени тоже, но то такое.... | |
| |
| |
| |
|
|
| | А так?
...
Set aTxtBox(i).oTxtBox = txtBox
...
|
| |
| |
| |
| |
|
|
| | дык, а мне то надо чтобы вот у этих Me.Controls("txtValue" & i) появились свойства.... в итоге....
| |
| |
| |
| |
|
|
| | А попробовал ссылаться напрямую?
//подозреваю, что мало что измениться, а вдруг... :)
Я так понял, нужно, что бы события обрабатывались.
Вечером поиграюсь. | |
| |
| |
|
|
| |
|
|
| | Молодец, да! | |
| |
| |
| |
|
|
| | нашел да
Me.imListTV.MaskColor = RGB(0, 0, 0)
| |
| |
| |
| |
|
|
| | две буквы в префиксе сокращения типа контрола в имени контрола это не есть гуд | |
| |
| |
| |
|
|
| | (с) Винни-Пох | |
| |
| |
| |
|
|
| | Дошло.
Те события, которых не хватает - это события класса Control.
| |
| |
| |
| |
|
|
| | Дальнейшие извращения показали - при попытке объявить переменную с событиями As Control в классе,
в рун-е приводят к ошибке 459 'Object or class does not support the set of events, хотя компилируется нормально.
Вот о похожем случае пишет Бенедикт: http://www.sql.ru/forum/actualutils.aspx?action=gotomsg&tid=483552&msg=5340709 | |
| |
| |
| |
|
|
| |
спасибо! пороемся | |
| |
| |
| |
|
|
| | почему у меня при выполнении процедуры, вызов которой стоит на соответствующем пункте меню,
при выставленной точке останова не происходит этого самого останова?
но процедура сама выполняется
пункт меню, из которого она вызывается был добавлен программно
шо за гамно? | |
| |
| |
| |
|
|
| | Типа выполняется не твоя процедура, а встроенная  | |
| |
| |
| |
|
|
| | ужо разобрались :) двойная бухгалтерия  | |
| |
| |
| |
|
|
| | Силыч а ты пример выложишь? как учебное пособие. | |
| |
| |
| |
|
|
| | та вроде от (16.09.2011 в 08:46) похоже на примерку | |
| |
| |
| |
|
|
| | хз, но может так как-то...
http://www.mrexcel.com/forum/showthread.php?t=66773 | |
| |
| |
| |
|
|
| | Не, не по-пацански то.
В первом примере утюжок с Do: ... DoEvents: Loop,
во втором с Application.OnTimer.
На процессоре яичницу жарить можна будет. :) | |
| |
| |
| |
|
|
| | та я внимательно разбор полетов не устраивал, некогда было :))
по верхам нахватался... ну и хрен с ними :)  | |
| |
| |
| |
|
|
| | короче решил пока пацаватый способ :)
разместил на форме статический текстбокс
и при событии на динамическом - нажатие кнопки - ставлю статический на место динамического, и присваиваю ему значение динамического :) после события - exit у статического, присваиваю значение обратно :)
проверка данных и присваивание проходит нормально :) пока что...
есть некоторые непонятки, но поборюс еще :)
зато есть все события :) ыыы
ну, за дебилизм | |
| |
| |
| |
|
|
| | Я за вами не поспеваю.
ыыыыы... :) | |
| |
| |
| |
|
|
| | все работает!
в классе по текстбоксу
Option Explicit
Public WithEvents oTxtBox As MSForms.TextBox 'создаем элемент с отслеживанием его событий
'за назначение с отслеживанием событий отвечает оператор WithEvents
'(может применяться только в модулях классов)
'и события не все :(
'-- а пох! создадим статический текстбокс на форме и будем юзать :)
Private Sub oTxtBox_Change()
On Error GoTo err123
With frmReports.txtValidate
frmReports.idRowActive = Replace(oTxtBox.name, "txtValue", "")
.ZOrder 0
.top = oTxtBox.top
.left = oTxtBox.left
.Height = oTxtBox.Height
.Width = oTxtBox.Width
.BackStyle = fmBackStyleOpaque
.BorderStyle = fmBorderStyleNone
.TextAlign = fmTextAlignLeft
.SpecialEffect = fmSpecialEffectEtched
.value = oTxtBox.value
.Visible = True
.SetFocus
End With
Exit Sub
err123:
MsgBox Error, , "ValidateEdit #" & Err
Exit Sub
End Sub
|
в форме, где инициализируются динамические
Public Sub txtValidate_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo err123
Select Case Me.Controls("txtFormat" & idRowActive).value
Case "List", "List®"
Case "Text", "Text®"
Case "Number"
If Not IsNumeric(Me.txtValidate) And Me.txtValidate <> "null" Then
MsgBox "Требуется Число или слово 'null'", , "ValidateEdit"
Cancel = True
Exit Sub
End If
Case "Number®"
If Not IsNumeric(Me.txtValidate) Then
MsgBox "Требуется Число", , "ValidateEdit"
Cancel = True
Exit Sub
End If
Case "Date", "Date®"
If Not IsDate(Me.txtValidate) Then
MsgBox "Требуется дата", , "ValidateEdit"
Cancel = True
Exit Sub
End If
Case "Check", "Check®"
Case "Select", "Select®"
End Select
Exit Sub
err123:
MsgBox Error, , "txtValidate_BeforeUpdate"
Exit Sub
End Sub
Private Sub txtValidate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Me.Controls("txtValue" & idRowActive).value = Me.txtValidate.value
Me.txtValidate.Visible = False
On Error Resume Next ' бывает косячек, некогда досматривать :)
Me.Controls("txtValue" & idRowActive).SetFocus
End Sub
|
в целом роде как на сейчас работает как надо :)
потестирую пока что :)
в общем концепция подходит
с чем всех нас и пряздрявляю на данном этапе | |
| |
| |
| |
72 Кб. |
|
| | Уууу.... :)
А почему-бы не пользовать ListBox и
пару-тройку стационарных контролов для редактирования/изменения?
типа => | |
| |
| |
| |
|
|
| | там нуна форма динамическая :/
в аксессе или на вэбэ я пользовал флексгрид - там все есть :)
а здесь ограничили таким наборчиком контролов :) контролы в форме строятся в зависимости от ..... | |
| |
| |
| |
|
|
| | Понятненько.
Успехов в етом нелегком.
:)
| |
| |
| |
|
|
| |
|
|
| | кстате, объявил массив контролов класса типа Текстбокс
не глобально в модуле , как где-то настаивали,
а в каждой форме, в которых будут использоваться, сколько надо.
пока, тьфу-тьфу-тьфу, всё работает  | |
| |
| |
| |
|
|
| | И правильно, иначе - висяки.
Или коллекцию, но там-же.
| |
| |
| |
| |
|
|
| | именно из-за них, болезных, и надоумился :) | |
| |
| |
