开发者

Creating a 'box' within Excel for date range

The below extracts info by clicking a single button:

Sub Sales()

Dim StrSQl As String

Con = "Provider=IBMDA400;Data Source=XXX.XXX.XXX.XXX;User Id=yyyy;Password=zzzz"

Set Db = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.recordset")
Db.connectionSTring = Con
Db.Open
StrSQl = "select myuc, sum (myac) as Amount from myabc.myqwerty where mydt >= 20100101 and mydt <= 20100831 group by (mycl)"
rs.Open StrSQl, Db, 3, 3
Sheet2.Cells(1, 1).CopyFromRecordset rs
rs.Close
Set rs = Nothing
Set cn = Nothing
End Sub

How can I create a 'box' within Excel to se开发者_运维知识库lect the range of date (mydt >= 20100101 and mydt <= 20100831) before clicking the button?


in the VBA window, you can insert a UserForm. by clicking on the Insert Menu Item.

You can then add a couple of textboxes and a button to the form. Alternativly you could add a datepicker control which would be eaiser for the user to enter a correct date.

On the click event of the button you would retrieve the information from the textboxes. I would add a couple of parameters to the SQL string and add them to an ADO command object. you would end up with something like the following.

Sub Button1_Click()

    Dim strSql As String
    Dim cmd As ADODB.Command
    Dim db As ADODB.Connection
    Dim rs As ADODB.Recordset
    if IsDate(TextBox1.Text) and IsDate(TextBox2.Text) then
        Set db = New ADODB.Connection
        Set rs = New ADODB.Recordset
        Set cmd = New ADODB.Command

        db.ConnectionString = "Provider=IBMDA400;Data Source=XXX.XXX.XXX.XXX;User Id=yyyy;Password=zzzz"

        db.Open
        Set cmd.ActiveConnection = db
        strSql = "select myuc, sum (myac) as Amount from myabc.myqwerty where mydt >= ? and mydt <= ? group by (mycl)"
        cmd.CommandText = strSql
        cmd.CommandType = adCmdText
        cmd.Parameters(0).Value = CDate(TextBox1.Text)
        cmd.Parameters(1).Value = CDate(TextBox2.Text)
        Set rs = cmd.Execute

        Sheet2.Cells(1, 1).CopyFromRecordset rs

        rs.Close
        Set rs = Nothing
        Set db = Nothing
    Else
         MsgBox "Please ensure that you enter a Date in the to To and From boxes"
    End If
End Sub

Private Sub UserForm_Initialize()
    TextBox1.Text = DateTime.Date - 7
    TextBox2.Text = DateTime.Date + 1
End Sub

EDIT
I have updated the code by removing the named parameters and replacing with a question mark. this just makes it eaiser, as the command object creates the parameters for you, you just need to set the values. one thing to note is the order of parameters. I have executed this code in Excel 2007 the only thing I changed was the connection string and the SqlString. to verify that it works.

EDIT 2
Add a reference to Microsoft Activex Data Objects (ADO) via Tools -> References.

EDIT 3
Added some validation to ensure the user enters dates.

Edit 4
Added initialisation of the Textboxes to set some default dates from a week ago to today.

EDIT 5 Check that the Textbox name matches the one in the code. they should be the same.

Creating a 'box' within Excel for date range

0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜