PDA

View Full Version : [SOLVED] vba to keep the focus on userform last used textbox



kevvukeka
07-02-2014, 02:35 AM
Hi All,

I have created a userform. My team would copy data from other applications and paste it in different text boxes on userform.

Whenever they use ALt+Tab to toggle between different other excel sheets or application and come back to userform the focus is not staying in userform. it is on a cell in the sheet1 of the workbook that contains the userform. Kindly suggest how can I avoid this.

Below is what I tried but it wont work.




Private Sub Workbook_Activate()
TSUF.Show vbModeless
TSUF.textbox13.setfocus
End Sub


Private Sub Workbook_Deactivate()
TSUF.Hide
End Sub



when I toggle between different applications and comeback to useform I would like the cursor to be in userfom in the last textbox which I updated or edited.

can someone help me with this.

Thanks a lot for your time.

OG Loc
07-02-2014, 02:57 AM
See if using .Activate instead of .SetFocus makes any difference. You'll need some way of storing which text box was looked at last too, probably in a public variable.

Bob Phillips
07-02-2014, 04:44 AM
There is no activate method for a userform control.

@kevvukeka, try setting to the focus to some other control in your code, then setting it to the control you really want to have focus.

kevvukeka
07-09-2014, 02:20 AM
Hi xld,

I tried your solution and its working fine. But I am not able to set the focus to the last used textbox or list box. I tried the below code but it will not give me the desired result.





Private Sub Workbook_Activate()
TSUF.Show vbModeless
TSUF.CommandButton3.SetFocus

If TSUF.ListBox1.ListIndex > -1 And TSUF.ListBox1.ListIndex < 6 Then
If TSUF.TextBox13 = "" Then TSUF.TextBox13.SetFocus
ElseIf TSUF.TextBox6 = "" Then TSUF.TextBox6.SetFocus
ElseIf TSUF.TextBox7 = "" Then TSUF.TextBox7.SetFocus
ElseIf TSUF.TextBox8 = "" Then TSUF.TextBox8.SetFocus
ElseIf TSUF.TextBox9 = "" Then TSUF.TextBox9.SetFocus
ElseIf TSUF.TextBox11 = "" Then TSUF.TextBox11.SetFocus
ElseIf TSUF.ListBox1.ListIndex > 5 Then TSUF.TextBox11.SetFocus
'Else: TSUF.ListBox1.SetFocus
End If
end if
End Sub

GTO
07-09-2014, 03:57 AM
Apologies up front if I am missing huge amounts, but have you tried saving a reference to what the activecontrol is before hiding the form?

Mark

Bob Phillips
07-09-2014, 04:49 AM
Can we see the workbook, and some details on how to reproduce the problem?

kevvukeka
07-09-2014, 06:02 AM
Hi xld,

Please find attached the workbook in which user form is created. I need help to keep the focus on the last textbox or list box used while using Alt+Tab as we would be pasting data from different applications in to this user form.

Before submitting the data I have kept few validations to check so that proper data gets submitted into the file. IF you click submit it may not work for you as the destination path is not accessible to you. you can change it.

I am not sure if it is due to those list of check points before submitting ,that the user form keeps shifting a little to left side every time I click submit. Kindly help.

Thanks for your time.


Hi GTO,

This is my first user form which I prepared. I am not sure how to store the last accessed textbox or listbox into a variable.


Thanks a lot for you help.

GTO
07-10-2014, 11:02 PM
...I have created a userform. My team would copy data from other applications and paste it in different text boxes on userform.

Whenever they use ALt+Tab to toggle between different other excel sheets or application and come back to userform the focus is not staying in userform...

Greetings,
I am not exactly sure if this does what you want; I hope so. I noted that you mention switching to other applications, and I started thinking that checking what window has the focus may be a way to go.

Anyways, the basic bits are...

In the Userform's Module:



Option Explicit

'===API CONSTANTS
'None

'===API
Private Declare Function GetForegroundWindow Lib "user32" () As Long

Private Declare Function GetActiveWindow Lib "user32" () As Long

Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long

Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, _
ByVal nIDEvent As Long) As Long

' Previous variables
Public wb1 As Workbook, iwb2 As Workbook
Public i As Long
'===Added variables

'===Properties
Private hWndForm As Long
Private lTimerRet As Long
Private bLostFocus As Boolean
Private sActiveCtrlName As String

'Read-Only
Public Property Get FormHandle() As Long
FormHandle = hWndForm
End Property
Public Property Get Control01Name() As String
Control01Name = "TextBox1"
End Property
Public Property Get Control02Name() As String
Control02Name = "TextBox2"
End Property

'Read-Write
Public Property Let FocusLost(fl As Boolean)
bLostFocus = fl
End Property
Public Property Get FocusLost() As Boolean
FocusLost = bLostFocus
End Property
Public Property Let ActiveControlName(acn As String)
sActiveCtrlName = acn
End Property
Public Property Get ActiveControlName() As String
ActiveControlName = sActiveCtrlName
End Property


Public Function ForeWndHwnd() As Long
ForeWndHwnd = GetForegroundWindow()
End Function



Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Dim lKillTimerRet As Long

If CloseMode = 0 Then
Cancel = True
MsgBox "Please use the Exit button on the Userform"
Else
'// If we are unloading the form, kill the timer. //
lKillTimerRet = KillTimer(hWndForm, lTimerRet)
End If

'Debug.Print "Timer killed in QueryClose = " & (lKillTimerRet <> 0) & "; Cancel = " & CBool(Cancel)

End Sub

Private Sub UserForm_Initialize()

With Me
'// Change caption to something unlikely to exist in another titlebar, get the handle //
'// to this form's window, change the caption back. //
.Caption = "123123123123"
hWndForm = FindWindow("ThunderDFrame", .Caption)
.Caption = "TimeSheet - " & Application.UserName

'// Cursory check //
If TypeName(.ActiveControl) = "ListBox" Or TypeName(.ActiveControl) = "TextBox" Then
sActiveCtrlName = .ActiveControl.Name
End If

End With

'// Set a timer, passing a pointer to Me. //
lTimerRet = SetTimer(hWndForm, ObjPtr(Me), 50&, AddressOf TimerProc)

Set wb1 = ThisWorkbook

'code to get username and date on initializing the userform
TextBox1.Value = Application.UserName
TextBox2.Value = Format(CDate(Date), "DD-MMM-YYYY")
'code to add values to the listbox (Task List)
With ListBox1
For i = 2 To wb1.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
.AddItem wb1.Sheets(1).Range("A" & i).Value
Next i
End With

End Sub


And the callback in a Standard Module:


Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal oForm As TSUF, ByVal dwTime As Long)
Dim lRet As Long
Dim lPrevHwnd As Long
Dim sJumpFromCtrl As String

'// It would probably be easier just to stick the API functions in this Standard Module.//
'// I had just started writing it this way. //
lRet = oForm.ForeWndHwnd

'// Test to see if the fore window is the form, or any other window. //
If Not lRet = oForm.FormHandle Then
oForm.FocusLost = True
Else
'// If the fore window IS the form, then see if it just received focus again, and if //
'// so... //
If oForm.FocusLost Then
oForm.FocusLost = False
'// ...try and set the focus to the last active control. //
On Error Resume Next
If Len(oForm.ActiveControlName) > 0 Then
If oForm.ActiveControlName = oForm.Control01Name Then
sJumpFromCtrl = oForm.Control02Name
Else
sJumpFromCtrl = oForm.Control01Name
End If
oForm.Controls(sJumpFromCtrl).SetFocus
DoEvents
'lPrevHwnd = SetFocusAPI(oForm.Frame1.[_GethWnd])
'Debug.Print lPrevHwnd
oForm.Controls(oForm.ActiveControlName).SetFocus
End If
On Error GoTo 0
'// Else, if the form does have focus and did not just receive it, track what control //
'// is active. //
Else
If TypeName(oForm.ActiveControl) = "ListBox" Or TypeName(oForm.ActiveControl) = "TextBox" Then
oForm.ActiveControlName = oForm.ActiveControl.Name
ElseIf TypeName(oForm.ActiveControl) = "Frame" Then
oForm.ActiveControlName = oForm.Frame1.ActiveControl.Name
End If
End If
End If
End Sub


I attached your workbook with these mods. Does that help?

Mark

GTO
07-10-2014, 11:05 PM
Err... Droool...

I sorta forgot the attachment. Here it is.

kevvukeka
07-11-2014, 03:01 AM
Hi GTO,

Thanks a lot for that. I never knew that a concept called pointer exists in this VBA. Its my first year into VBA(You could have know by looking at my code that I wrote).

I tried to check your file but I get Type mismatch error at this line.



lTimerRet = SetTimer(hWndForm, ObjPtr(Me), 50&, AddressOf TimerProc)


I checked in google to find out the use of ObjPtr but couldn't understood a thing.

So kindly suggest how I should proceed further.

Thanks for your time.

GTO
07-11-2014, 03:31 AM
Hi GTO,

Thanks a lot for that. I never knew that a concept called pointer exists in this VBA. Its my first year into VBA(You could have know by looking at my code that I wrote).

I tried to check your file but I get Type mismatch error at this line.



lTimerRet = SetTimer(hWndForm, ObjPtr(Me), 50&, AddressOf TimerProc)


I checked in google to find out the use of ObjPtr but couldn't understood a thing.

So kindly suggest how I should proceed further.

Thanks for your time.

I cannot "see" your end of course, but I am baffled if the error is a miss match, assuming you have lTimerRet dimensioned as a Long. When you say, "I tried to check your file...", do you mean literally you downloaded the attachment and it doesn't run successfully? I downloaded it to my desktop and it ran fine.

Mark

kevvukeka
07-14-2014, 04:28 AM
yes I downloaded the file...At the beginning I got the popup to declare modify the code to 62 bit attachment. I changed the declarations of variable using Ptrsafe as below:



Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As Long

Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As Long

Private Declare PtrSafe Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long

Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As Long, _
ByVal nIDEvent As Long) As Long



Is it the change in above declaration that's causing this error? I am not sure.. Kindly suggest.

GTO
07-14-2014, 05:11 AM
yes I downloaded the file...At the beginning I got the popup to declare modify the code to 62 bit attachment. I changed the declarations of variable using Ptrsafe as below:



Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As Long


Is it the change in above declaration that's causing this error? I am not sure.. Kindly suggest.

Oh goodness(!) - I am out of my element here! Off to bed, and I do not have 64-bit, but let me see if I can fix my suggestion a bit (<---no pun) over the next day or two. For the declarations, I believe you'll want to get a copy of Win32API_PtrSafe.txt

By example, you show GetForegroundWindow as returning a Long, when I believe it should return a LongPtr in 64.



Declare PtrSafe Function GetForegroundWindow Lib "user32" Alias "GetForegroundWindow" () As LongPtr


Mark

Bob Phillips
07-14-2014, 11:07 AM
You should set the hWnd argument from type Long to LongPtr, and the same for lpTimerFunc, and GetForegroundWindow, GetActiveWindow, FindWindow and SetTimer should all return LongPtr.

GTO
07-14-2014, 10:14 PM
You should set the hWnd argument from type Long to LongPtr, and the same for lpTimerFunc, and GetForegroundWindow, GetActiveWindow, FindWindow and SetTimer should all return LongPtr.

Hi Bob:hi:

I included nIDEvent as per an example I spotted and my (hopefully accurate) take of:

nIDEvent Type: UINT_PTR

wherein I [I]think that means an unsigned integer pointer?

I realize your response may have been aimed at the OP, but I might as well practice. Hopefully this is correct:

Userform declaration section and affected module-level variables:



'===API
#If VBA7 Then

Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, _
ByVal nIDEvent As LongPtr, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As LongPtr _
) As LongPtr

Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, _
ByVal nIDEvent As LongPtr _
) As Boolean

Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String _
) As LongPtr

#Else

Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long _
) As Long

Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, _
ByVal nIDEvent As Long _
) As Long

Private Declare Function GetForegroundWindow Lib "user32" () As Long

Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

#End If

#If VBA7 Then
Private hWndForm As LongPtr
#Else
Private hWndForm As Long
#End If

Affected properties/function in userform:


'Read-Only
#If VBA7 Then
Public Property Get FormHandle() As LongPtr
#Else
Public Property Get FormHandle() As Long
#End If
FormHandle = hWndForm
End Property

#If VBA7 Then
Public Function ForeWndHwnd() As LongPtr
#Else
Public Function ForeWndHwnd() As Long
#End If
ForeWndHwnd = GetForegroundWindow()
End Function


Modified callback:


Option Explicit

#If VBA7 Then

Public Sub TimerProc(ByVal hwnd As LongPtr, ByVal uMsg As Long, ByVal oForm As TSUF, ByVal dwTime As Long)
Dim lRet As LongPtr

#Else

Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal oForm As TSUF, ByVal dwTime As Long)
Dim lRet As Long

#End If

Dim sJumpFromCtrl As String

lRet = oForm.ForeWndHwnd

If Not lRet = oForm.FormHandle Then
oForm.FocusLost = True
Else

If oForm.FocusLost Then

oForm.FocusLost = False

On Error Resume Next
If Len(oForm.ActiveControlName) > 0 Then
If oForm.ActiveControlName = oForm.Control01Name Then
sJumpFromCtrl = oForm.Control02Name
Else
sJumpFromCtrl = oForm.Control01Name
End If
oForm.Controls(sJumpFromCtrl).SetFocus
DoEvents
oForm.Controls(oForm.ActiveControlName).SetFocus
End If
On Error GoTo 0

Else

If TypeName(oForm.ActiveControl) = "ListBox" Or TypeName(oForm.ActiveControl) = "TextBox" Then
oForm.ActiveControlName = oForm.ActiveControl.Name
ElseIf TypeName(oForm.ActiveControl) = "Frame" Then
oForm.ActiveControlName = oForm.Frame1.ActiveControl.Name
End If

End If

End If
End Sub


Hi Kevvukeka,

I believe I have this correct, but I would suggest waiting until XLD or another member used to the new declarations comments. Or, at least I would have only the one workbook open and nothing unsaved before I ran it. As I think I mentioned, I am unaware of any of the PCs where I work having Office installed in 64-bit, so the most I can assuredly say is that it runs in 32-bit Excel 2010.

Mark

GTO
07-14-2014, 10:19 PM
For some reason the #End If's got cut-off in the rendering, but they are there. Here's the modified wb.

GTO
07-15-2014, 03:25 AM
Sorry All,

I thought to ask this after the Edit expired...

@xld:

Just if you have time, does my solution seem on-track, or would you do something different?

Thank you so much,

Mark

Bob Phillips
07-15-2014, 04:06 AM
Haven't looked at it closely Mark, but it looks about right and I would definitely use conditional compilation.

GTO
07-15-2014, 05:12 AM
@xld:

Thank you on both counts. Hopefully the OP will be able to verify it runs in 64. My last question was more at would you use a timer (or similar callback) for when other apps are active?

Again, thank you very much. As a 'not-a-real/professional coder' - coder, some of this stuff is a bit mystifying (C++ and API in general) and I often miss something Excel may have built-in. I hope that makes sense?

BTW - how's your weather been? I am thinking this must be a nice time of year there. Just struck me, as we seem to have jumped into Monsoon season. Nothing devastating mind you; just awfully dusty, humid and hot, all at once...

Mark

jonh
07-15-2014, 06:26 AM
Maybe this does a similar thing without the api calls?


'in the form
Private Sub UserForm_Activate()
Set frm = UserForm1
delay = (1 / 24 / 60 / 60) * 3 '3 seconds
tmrfocus
End Sub

'in a module
Public frm As UserForm, delay As Single
Sub tmrfocus()
On Error Resume Next
Dim p As Integer, l As Integer
With frm.ActiveControl
If TypeName(frm.ActiveControl) = "TextBox" Then
p = .SelStart
l = .SelLength
For Each c In frm.Controls
If c.Name <> .Name Then
c.SetFocus
Exit For
End If
Next
.SetFocus
.SelStart = p
.SelLength = l
Application.OnTime Now + delay, "tmrfocus"
End If
End With
End Sub


Anyway, this only seems to be a problem if the form isn't modal so the simple question is, does it really need to be modeless?

kevvukeka
07-16-2014, 12:22 AM
Hi GTO,

I downloaded your new user form workbook. It got downloaded in PHP and I opened it with excel. I still get the error as shown in the attached JPEG. I checked again if all the required variable as suggested by XLD were declared as longPtr but still it it get this error as soon as I open the workbook.



Hi jonh,

I tried your code. Though I don't see the cursor in the last text box or list box which I last worked, when I click tab on activating the user form (between ALt+tab) I move to the next list box or textbox in which I last worked.i The form has to be modeless because we would be working with several other excel simultaneously and need to copy and paste the data in this use form.


I want to thank everyone who has been trying to help me out here. Thanks a lot..

kevvukeka
07-16-2014, 12:24 AM
Just in case if the attached jpeg is not clear, the error is "Type Mismatch" at the below line:



lTimerRet = SetTimer(hWndForm, ObjPtr(Me), 50&, AddressOf TimerProc)

GTO
07-16-2014, 01:24 AM
Please attach your workbook, exactly as it is, with the error occurring.

Thank you so much,

Mark

kevvukeka
07-16-2014, 01:31 AM
Please attach your workbook, exactly as it is, with the error occurring.

Thank you so much,

Mark



thanks..

jonh
07-16-2014, 01:35 AM
Didn't notice you'd posted a sample wb. Only done a quick test but it seems to work now.

Put the other code in your initialise and this in a module.


Sub tmrfocus()
On Error Resume Next
Dim p As Integer, l As Integer

With frm.ActiveControl
If TypeName(frm.ActiveControl) = "TextBox" Then
p = .SelStart
l = .SelLength
For Each c In frm.Controls
If (c.Name <> .Name) And (TypeName(c) = "TextBox") Then
c.SetFocus
Exit For
End If
Next
.SetFocus
.SelStart = p
.SelLength = l
Application.OnTime Now + delay, "tmrfocus"
Else
Application.OnTime Now + delay, "tmrfocus"
End If
End With
End Sub


++Edit++
I'd assumed you'd only need this for textboxes so that's all I checked for.
Just modify the ifs to add whatever controls you need.

kevvukeka
07-16-2014, 02:04 AM
Hi Jonh,


Attached is the WB with changes as suggested by you. Its working with little delay. Can we reduce that delay time? When I click exit on the userform previously the form along with excel used to get closed but now it gets hanged.

GTO
07-16-2014, 02:42 AM
First, change this bit and run it. It was the only argument I typed differently than XLD suggested, so just in case the example I went from and my understanding of MSDN was off, it's a quick check.



#If VBA7 Then

'Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, _
' ByVal nIDEvent As LongPtr, _
' ByVal uElapse As Long, _
' ByVal lpTimerFunc As LongPtr _
' ) As LongPtr

Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As LongPtr _
) As LongPtr


'Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, _
' ByVal nIDEvent As LongPtr _
' ) As Boolean

Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, _
ByVal nIDEvent As Long _
) As Boolean


If that works, great, and I'll try and learn why. If not, change it back to nIDEvent as LongPtr and proceed as follows:


Okay, I downloaded the file and it runs fine for me. I am at a loss, so I think it is time to step through the code.

I'm not sure how long I can hang, but you seem to be available. Hopefully these efforts aren't skipping something painfully obvious, that we just aren't grasping.

Ready?

SaveAs a junk copy of the wb you posted.

REM (Comment out) in the form's Initialize like...



Private Sub UserForm_Initialize()

With Me

' .Caption = "123123123123"
' hWndForm = FindWindow("ThunderDFrame", .Caption)
' .Caption = "TimeSheet - " & Application.UserName
'
' If TypeName(.ActiveControl) = "ListBox" Or TypeName(.ActiveControl) = "TextBox" Then
' sActiveCtrlName = .ActiveControl.Name
' End If

End With

' lTimerRet = SetTimer(hWndForm, ObjPtr(Me), 50&, AddressOf TimerProc)
'
' Set wb1 = ThisWorkbook
'
' txtName.Value = Application.UserName
' txtDate.Value = Format(CDate(Date), "DD-MMM-YYYY")
With lstTask
' For i = 2 To wb1.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
' .AddItem wb1.Sheets(1).Range("A" & i).Value
' Next i
End With

End Sub


Now in ThisWorkbook, start stepping through Workbook_Activate. You should make it through to showing the form. Start un-commenting lines, one-by-one; of course un-commenting If/End If or For/Next logically. each time you un-comment a line, again step through from Workbook_Activate. We should be able to determine exactly what line fouls.

Mark

jonh
07-16-2014, 03:13 AM
First part now needs to go in activate. Wont work from initialise. And it's where you set the delay time.


Private Sub UserForm_Activate()
Set frm = TSUF
'You can change the delay time here
'delay = (1 / 24 / 60 / 60) * 3 '3 seconds
delay = (1 / 24 / 60 / 60) * 2 '2 seconds
'delay = (1 / 24 / 60 / 60) * 1 '1 seconds
tmrfocus
End Sub


The Buttons and the Textboxes in frames should now also work.


Public frm As UserForm, delay As Single
Sub tmrfocus()
Dim p As Integer, l As Integer, ctl As Control
If Not frm.ActiveControl Is Nothing Then
Set ctl = frm.ActiveControl
If TypeName(ctl) = "Frame" Then Set ctl = ctl.ActiveControl
Select Case TypeName(ctl)
Case "TextBox"
p = ctl.SelStart
l = ctl.SelLength
For Each c In frm.Controls
If (c.Name <> ctl.Name) And (TypeName(c) = "TextBox") Then
c.SetFocus
Exit For
End If
Next
ctl.SetFocus
ctl.SelStart = p
ctl.SelLength = l
Case "CommandButton"
For Each c In frm.Controls
If (TypeName(c) = "TextBox") Then
c.SetFocus
Exit For
End If
Next
ctl.SetFocus
End Select
Application.OnTime Now + delay, "tmrfocus"
End If
End Sub

kevvukeka
07-16-2014, 03:55 AM
Hi Mark,

I tried to follow as you suggested but I still get the error message at this line:



lTimerRet = SetTimer(hWndForm, ObjPtr(Me), 50&, AddressOf TimerProc) at ObjPtr(Me).


I changed nIDEvent as LongPtr and stepped through the code in Thisworkbook. It worked fine. Attached is the revised workbook. Please take your time.

kevvukeka
07-16-2014, 04:50 AM
Hi Jonh,

Attached is the revised Workbook as per your suggestions, but I am not able to exit the form now. It gets struck. Whenever I click exit all other open workbooks stop working.

jonh
07-16-2014, 07:17 AM
Ok I'll give it one more try. Sorry I can't upload files from here.

Module...


Public frm As UserForm, delay As Date, lasttime As Date
Public Sub tmrfocus()
CancelFocusTimer

Dim p As Integer, l As Integer, ctl As Control
If frm Is Nothing Then Exit Sub
If Not frm.ActiveControl Is Nothing Then
Set ctl = frm.ActiveControl
If TypeName(ctl) = "Frame" Then Set ctl = ctl.ActiveControl
Select Case TypeName(ctl)
Case "TextBox"
p = ctl.SelStart
l = ctl.SelLength
For Each c In frm.Controls
If (c.Name <> ctl.Name) And (TypeName(c) = "TextBox") Then
c.SetFocus
Exit For
End If
Next
ctl.SetFocus
ctl.SelStart = p
ctl.SelLength = l
Case "CommandButton"
For Each c In frm.Controls
If (TypeName(c) = "CommandButton") Then
c.SetFocus
Exit For
End If
Next
ctl.SetFocus
End Select
lasttime = Now + delay
Application.OnTime lasttime, "tmrfocus", , True
End If
End Sub

Public Sub CancelFocusTimer()
On Error Resume Next
Application.OnTime lasttime, "tmrfocus", , False
End Sub

form ...



Private Sub UserForm_Activate()
Set frm = TSUF
delay = #12:00:02 AM# '2 second delay
tmrfocus
End Sub
Private Sub UserForm_Terminate()
CancelFocusTimer
End Sub

GTO
07-17-2014, 02:53 AM
Greetings Kevvukeka,

Let us try an easy fix before I either pull my hair out and/or write several different ways of declaring it. At the advisement of Aflatoon, I botched typing the return of SetTimer in 64-bit. I believe it needs to be a LongPtr (or a LongLong I think). Anyways, in the attachment at post #16, change just this part...


'
===Properties
#If VBA7 Then
Private hWndForm As LongPtr
#Else
Private hWndForm As Long
#End IfPrivate lTimerRet As Long


to...



'===Properties
#If VBA7 Then
Private hWndForm As LongPtr
Private lTimerRet As LongPtr
#Else
Private hWndForm As Long
Private lTimerRet As Long
#End If


I believe that will fix it, as the only other thing that I wonder about right off is ObjPtr(Me), but at least by what I read on MSDN, ObjPtr()'s return is handled by the application.

Mark

kevvukeka
07-17-2014, 03:42 AM
Hi Mark,

I changed the code as below



'===Properties
#If VBA7 Then
Private hWndForm As LongPtr
Private lTimerRet As LongPtr
#Else
Private hWndForm As Long
Private lTimerRet As Long
#End If

'Private lTimerRet As Long
Private bLostFocus As Boolean
Private sActiveCtrlName As String



But again I get mismatch error message at this line:



lTimerRet = SetTimer(hWndForm, ObjPtr(Me), 50&, AddressOf TimerProc)


Sorry for all the trouble. I am not able to help you from my end as I my not familiar with this level of coding(I mean the coding what you did), I am at beginner level.

However, the below code provided by Jonh is currently working as I desired with a little delay and its ok for me take it further.



Public frm As UserForm, delay As Date, lasttime As Date
Public Sub tmrfocus()
CancelFocusTimer

Dim p As Integer, l As Integer, ctl As Control
If frm Is Nothing Then Exit Sub
If Not frm.ActiveControl Is Nothing Then
Set ctl = frm.ActiveControl
If TypeName(ctl) = "Frame" Then Set ctl = ctl.ActiveControl
Select Case TypeName(ctl)
Case "TextBox"
p = ctl.SelStart
l = ctl.SelLength
For Each c In frm.Controls
If (c.Name <> ctl.Name) And (TypeName(c) = "TextBox") Then
c.SetFocus
Exit For
End If
Next
ctl.SetFocus
ctl.SelStart = p
ctl.SelLength = l
Case "CommandButton"
For Each c In frm.Controls
If (TypeName(c) = "CommandButton") Then
c.SetFocus
Exit For
End If
Next
ctl.SetFocus
End Select
lasttime = Now + delay
Application.OnTime lasttime, "tmrfocus", , True
End If
End Sub

Public Sub CancelFocusTimer()
On Error Resume Next
Application.OnTime lasttime, "tmrfocus", , False
End Sub






Private Sub UserForm_Activate()
Set frm = TSUF
delay = #12:00:01 AM# '1 second delay
tmrfocus
End Sub
Private Sub UserForm_Terminate()
CancelFocusTimer
End Sub




Attached is the same file.. I changed the delay time to 1 sec..

Thanks a lot Jonh.. Thanks a lot Mark....

GTO
07-17-2014, 03:55 AM
Thank you for the feedback Kevvukeka. It sounds as if you consider this solved? I did try Jon's first bit and I didn't see where it would reset focus if switching apps. That is in no way a negative criticism, but rather wondering if I misread your overall issue?

Anyways, and still assuming this is solved for you: If I get a chance to write a couple of different ways of declaring SetTimer and KillTimer, would you mind testing them in 64-bit Office? You are in no way obliged of course, I just wanted to ask before trying to put it together. If I were to try, I would just try getting SetTimer started, a few "loops" and KillTimer to see if we can overcome whatever is happening.

Again, glad you got it fixed and an 'atta boy!' to Jon :-)

Mark

PS. I keep meaning to ask, just to confirm: What OS are you using; what version of Excel, and Excel (or Office) is installed in 64-bit?

kevvukeka
07-17-2014, 04:26 AM
Hi Mark,

I am ready to test any approach or any other alternative. Its all learning for me here.. Please feel free to suggest your approach.


I am still not done.. I need to link this userfom to an excel file that will contain all the excel records that got submiited from this userform. I need a scroll bar so that scrolling it would display all the records from that excel file in this userfom one at a time. Objective is to be able to edit/delete a record that already got submitted.


I work on 64 bit OS, MS office 2010.

GTO
07-17-2014, 04:30 AM
Thank you very much. Off to bed, but when you get a chance: WIN7, WIN8? I am unaware of any OS version issues, but surfing/searching sometimes makes one aware of some bizarre bugs.

jonh
07-17-2014, 07:01 AM
Not a big deal really, but if you are going to use my version ...

I just spotted that this bit of code got changed somehow


Case "CommandButton"
For Each c In frm.Controls
If (TypeName(c) = "CommandButton") Then '<------

It needs changing back to


Case "CommandButton"
For Each c In frm.Controls
If (TypeName(c) = "TextBox") Then '<------

@GTO
I haven't read your code so no idea what it does.
Mine just uses a timer to constantly reset the focus to the last active control.
It does this even while Excel is active(!).
Can't say I like my solution very much but there you go.
If yours detects that Excel has lost focus, maybe the two can be combined.

kevvukeka
07-28-2014, 11:09 PM
Thanks a lot Jonh...