Создание «коробки» в Excel для диапазона дат

Question

Приведенная ниже информация извлекается нажатием одной кнопки:

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

Как создать «коробку» в Excel для выбора диапазона дат (mydt> = 20100101 и mydt <= 20100831) донажатием кнопки? </p>

Answer 1

в окне VBA вы можете вставить пользовательскую форму. нажав на пункт Вставить пункт меню.

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

По событию нажатия кнопки вы извлекаете информацию из текстовых полей. Я хотел бы добавить пару параметров в строку SQL и добавить их в объект команды ADO. вы получите что-то вроде следующего.

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
Я обновил код, удалив названные параметры и заменив знак вопроса. это просто делает его более удобным, так как объект команды создает параметры для вас, вам просто нужно установить значения. Стоит отметить порядок параметров. Я выполнил этот код в Excel 2007, единственное, что я изменил, это строка подключения и SqlString. чтобы убедиться, что это работает.

РЕДАКТИРОВАТЬ 2
Добавьте ссылку на объекты данных Microsoft Activex (ADO) через Сервис -> Ссылки.

РЕДАКТИРОВАТЬ 3
Добавлена ​​некоторая проверка, чтобы убедиться, что пользователь вводит даты.

Редактировать 4
Добавлена ​​инициализация текстовых полей для установки некоторых дат по умолчанию с недели назад до сегодняшнего дня.

РЕДАКТИРОВАТЬ 5 Убедитесь, что имя текстового поля совпадает с именем в коде. они должны быть одинаковыми.