Проблема с календарем в UserForm первой версии Escel 2003

Пользователь

Сообщений: 120 Регистрация: 22.12.2012

26.12.2012 04:08:34

Доброго времени суток уважаемые советчики и помощники, профессионалы данного форума.
У нас на работе первая, не обновленная версия Escel 2003 где нет в UserForm календаря 11 и т.п. Закинуть туда его также нет возможности (запрет админа). Как заменить данный календарь в моей UserForm, чтобы можно было ввести нужную дату в выделенное пространство "Дата замовлення" и чтобы выполнялась данная форма и макросы?? Спасибо за помощь всем тем, кто помог мне в создании данной формы и макросов, особенно R Dmitry.
Бесконечно благодарен за помощь.

Прикрепленные файлы

Report_Direst_v4.rar (330.06 КБ)

EducatedFool

Пользователь

Сообщений: 3695 Регистрация: 23.12.2012

26.12.2012 04:20:20

Календаря в Excel нет.
Он добавляется при расширенной установке Office (вроде бы, вместе с access)

Поэтому рекомендую использовать календарь, выполненный на стандартных элементах управления (будет работать у всех)
Пример можно посмотреть в прикреплённом файле к этой статье (и там же взять календарь):
http://excelvba.ru/programmes/Fill_Invoice

Надстройки для Excel Парсинг сайтов Мониторинг цен конкурентов

Бонифаций Пользователь Сообщений: 120 Регистрация: 22.12.2012	#3 26.12.2012 11:55:41 Спасибо за помощь, EducatedFool. Я использовал Ваш календарь. Но при запуске данной формы и выборе календаря выбивает ошибку. Помогите пожалуйста исправить. Прикрепленные файлы Report_Direst_v5.xls (199 КБ)

Бонифаций Пользователь Сообщений: 120 Регистрация: 22.12.2012	#4 26.12.2012 12:14:29 Извиняюсь... Не запароленный файл. Прикрепленные файлы Report_Direst_v5.xls (199.5 КБ)

Бонифаций

Пользователь

Сообщений: 120 Регистрация: 22.12.2012

26.12.2012 12:24:46

Учитывая все комбинации ошибку выбивает на:
Private Sub КнопкаВыбораДаты_Click()
Me.txt_Дата = Get_Date(Me.txt_Дата, Now) ' выбор даты из календаря
End Sub
Если я вношу дату вручную в окно-ошибка:
Private Sub CommandButton1_Click()
Dim oTbox As Object, d, k, n, ii&
If IsDate(Me.lDate.Caption) And Len(Me.TextBox2) > 0 Then

Спасибо Всем.

Бонифаций

Пользователь

Сообщений: 120 Регистрация: 22.12.2012

26.12.2012 12:44:37

Все. Подстроил календарь. Основной проблемой осталась ошибка при импорте данных:
Private Sub CommandButton1_Click()
Dim oTbox As Object, d, k, n, ii&
If IsDate(Me.lDate.Caption) And Len(Me.TextBox2) > 0 Then

d = CDate(Me.lDate.Caption)
k = Me.TextBox2

Прикрепленные файлы

Report_Direst_v6.xls (244 КБ)

sva Пользователь Сообщений: 1027 Регистрация: 23.12.2012	#7 26.12.2012 12:46:01 Вы форму с календарем из файла забрали, а код функции Get_Date() нет, находится в модуле Date_and_Time.

Бонифаций

Пользователь

Сообщений: 120 Регистрация: 22.12.2012

26.12.2012 12:57:23

Спасибо Вам. С Get_Date разобрался.
Проблема:
Private Sub CommandButton1_Click()
Dim oTbox As Object, d, k, n, ii&
If IsDate(Me.lDate.Caption) And Len(Me.TextBox2) > 0 Then

d = CDate(Me.lDate.Caption)
k = Me.TextBox2

Когда я удаляю
Dim oTbox As Object, d, k, n, ii&
If IsDate(Me.lDate.Caption) And Len(Me.TextBox2) > 0 Then

d = CDate(Me.lDate.Caption)
k = Me.TextBox2

и

Else
MsgBox "Введіть будь ласка початкові дані (дата замовлення,або ж код приймальника)!"
End If

идет импорт. Правда импорт идет очень неправильно: (: (: (

Прикрепленные файлы

Report_Direst_v6.xls (244 КБ)

Бонифаций Пользователь Сообщений: 120 Регистрация: 22.12.2012	#9 26.12.2012 13:00:08 А вот как должно было бы быть при замене календаря (см. вложения) Всем большое спасибо. Прикрепленные файлы Report_Direst_v4.xls (75.5 КБ)

Бонифаций Пользователь Сообщений: 120 Регистрация: 22.12.2012	#10 27.12.2012 04:37:44 Уважаемые профи. Помогите пожалуйста. Спасибо заранее Вам.

Юрий М Модератор Сообщений: 61089 Регистрация: 14.09.2012 Контакты см. в профиле	#11 27.12.2012 10:11:23 ЧТО конкретно не получается?

sva

Пользователь

Сообщений: 1027 Регистрация: 23.12.2012

#12

27.12.2012 10:12:26

Поменял код в CommandButton1_Click, правда я не очень понял в чем проблема

Скрытый текст

Код

Private Sub CommandButton1_Click()
Dim oTbox As Object, d, k, n, ii&
If IsDate(Me.txt_Дата) And Len(Me.TextBox2) > 0 Then
d = CDate(Me.txt_Дата)
k = Me.TextBox2
ReDim arr(1 To Me.Controls.Count, 1 To 3)
ReDim arr2(1 To 4, 1 To 3)
For Each oTbox In Me.Controls
If TypeOf oTbox Is MSForms.TextBox Then
n = LCase(oTbox.Name)
If (n <> "textbox1" And n <> "textbox2") And Len(oTbox.Value) > 0 Then
Select Case Val(Mid(n, 8))
Case 29, 32, 33, 34
i = i + 1
arr2(i, 1) = d
arr2(i, 3) = k
arr2(i, 2) = oTbox.Value
Case Else
ii = ii + 1
arr(ii, 1) = d
arr(ii, 3) = k
arr(ii, 2) = oTbox.Value
End Select
oTbox.Value = ""
End If: End If
Next oTbox
With Sheets("Звіт_1").[a1]
.Offset(.CurrentRegion.Rows.Count, 0).Resize(ii, 3) = arr
End With
With Sheets("Звіт_2").[a1]
.Offset(.CurrentRegion.Rows.Count, 0).Resize(i, 3) = arr2
End With
Else
MsgBox "Введіть будь ласка початкові дані (дата замовлення,або ж код приймальника)!"
End If
End Sub

Изменено: sva - 27.12.2012 10:14:39

Бонифаций

Пользователь

Сообщений: 120 Регистрация: 22.12.2012

#13

27.12.2012 13:08:41

Здравствуйте. Все работает.
Остался еще единственный нюанс: При импорте в закладку "Звіт_1" все импортируется, однако в конце добавляется еще одно значение даты выбранной в колонку В. (в файле выделены красным) Но там даты не должно быть. Как это исправить?? Импорт данных в "Звіт_2" проходит идеально Спасибо Вам.

Прикрепленные файлы

Report_Direst_v7.rar (46.98 КБ)

sva

Пользователь

Сообщений: 1027 Регистрация: 23.12.2012

#14

27.12.2012 16:57:58

Правильно, при переборе текстбоксов вы не проверяете, что этот текстбокс у вас отведен под дату.

код

Код

Private Sub CommandButton1_Click()
Dim oTbox As Object, d, k, n, ii&
    If IsDate(Me.txt_Дата) And Len(Me.TextBox2) > 0 Then
        d = CDate(Me.txt_Дата)
        k = Me.TextBox2
        ReDim arr(1 To Me.Controls.Count, 1 To 3)
        ReDim arr2(1 To 4, 1 To 3)
            For Each oTbox In Me.Controls
                If TypeOf oTbox Is MSForms.TextBox Then
                    n = LCase(oTbox.Name)
                    If (n <> "textbox1" And n <> "textbox2") And Len(oTbox.Value) > 0 And n <> "txt_дата" Then
                        Select Case Val(Mid(n, 8))
                        Case 29, 32, 33, 34
                            i = i + 1
                            arr2(i, 1) = d
                            arr2(i, 3) = k
                            arr2(i, 2) = oTbox.Value
                        Case Else
                            ii = ii + 1
                            arr(ii, 1) = d
                            arr(ii, 3) = k
                            arr(ii, 2) = oTbox.Value
                        End Select
                    oTbox.Value = ""
                End If: End If
            Next oTbox
             
    With Sheets("Звіт_1").[a1]
        .Offset(.CurrentRegion.Rows.Count, 0).Resize(ii, 3) = arr
    End With
    With Sheets("Звіт_2").[a1]
        .Offset(.CurrentRegion.Rows.Count, 0).Resize(i, 3) = arr2
    End With
    Else
        MsgBox "Введіть будь ласка початкові дані (дата замовлення,або ж код приймальника)!"
    End If
End Sub

PS используйте отступы в коде, сильно упрощают жизнь

Бонифаций Пользователь Сообщений: 120 Регистрация: 22.12.2012	#15 27.12.2012 17:25:58 Спасибо Вам большое, sva!

Читают тему