PDA

View Full Version : Activate DropDown List and Calendar when Cell Selected



TRLOS
10-15-2013, 04:21 AM
Its been many many years since I've done VB Scripting, so I apologize if this is a simple noob question.

I have created a type of form on Excel which will be used on a touch screen tablet.
I need 2 VBA scripts please.

I have used 2 worksheets. The first is the main form. The second worksheet is where I have a bunch of Data Values which are used in Data Validation Drop Down boxes.

Script 1 :
I have created a Drop Down List in Cell F16. At current, when you select F16, I can see the small arrow to the right of the cell so when you click on it, it pulls the Drop Down box down so you can select a value.

My question is, what is the VBA script so that when I select that particular cell, it opens the Drop Down list automatically (ALT+Down Arrow) ?
Can you make it that you can use the same script for the following 10 cells below the first one ?

I have found a similar code but have no idea how to change it to do what I want


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Address = "$A$1" Then
(What goes here to automatically open the Drop Down Box......ALT+Down Arrow.....)
End If

End Sub
(Is this the right script or is there another better suited?)

Script 2 :
I have created a Date Picker Calendar (the same as specified on this site 'fontstuff.com/excel/exltut03.htm)
I have added the following in VBA so that it inserts the Selected Date in the Highlighted Cell


Private Sub DTPicker1_Change()
ActiveCell.Value = Me.DTPicker1.Value
End Sub

Is there a way to automatically open the Date Picker when any cell from J16 - M38 is selected ?


The reason I want these scripts is because this Excel sheet will primarily be used on a touch screen, so would make it easier to use by Single-Tapping on the cell and have it automatically open the relevant areas (Drop Down Box & Date Picker)

Any help would be greatly appreciated.

Thanks in Advance

TRLOS
10-15-2013, 05:13 AM
SOLUTION for Script 1


Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Target.Column = 9 And (Target.Row >= 16 And Target.Row <= 38) Then
SendKeys "%{DOWN}"
End If
End Sub


Still need help with Script 2

SamT
10-15-2013, 06:52 AM
TRLOS,

Welcome to VBA Express.

I changed the Thread Title to better describe your questions. I hope that helps.

Kenneth Hobs
10-15-2013, 08:40 AM
When using Sendkeys() for Vista+, be sure to disable UAC.

For the 2nd part, I have not had time to fix the error when you close the dropdown by ESC key. Otherwise, create your Calendar control as explained in that link, and then:
In a Module:

Declare Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long

In the worksheet with the control:

' http://fontstuff.com/excel/exltut03.htm
' http://msdn.microsoft.com/en-us/library/aa231249%28v=vs.60%29.aspx
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Range, t As Long, l As Long
Set r = Intersect(Target, Range("J16:M38"))
If r Is Nothing Then Exit Sub
If r.Cells.Count > 1 Then Exit Sub

With DTPicker1
t = .Top
.Top = r.Top
l = .Left
.Left = r.Left
.Activate
DoEvents
Application.Wait Now() + TimeSerial(0, 0, 2)
SetFocus .hwnd
SendKeys ("{F4}"), True
DoEvents
r.Value = .Value
r.Select
.Top = t
.Left = l
End With
End Sub

TRLOS
10-15-2013, 10:59 PM
Just an idea on the error message when you press ESC, Can you add an "On Error Resume Next" somewhere ? Just to avoid the Debug screen from coming up and letting it continue working.

Kenneth Hobs
10-16-2013, 05:00 AM
No. I suspect that an API routine would be needed to check for that keypress. I don't have time to code that right now. Maybe I can this weekend if you still need it.