Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 16.08.2011, 21:59   #1
AKSENOV048
Пользователь
 
Аватар для AKSENOV048
 
Регистрация: 03.08.2011
Сообщений: 74
По умолчанию выбрать имя следующего листа из календаря

Добрый день!!! искал в интернете не нашел, как в данном коде сделать так, чтобы появлялось окошко, не InputBox, а UserForm с (стандартным) календарем, (в Toolbox нашел: MonthView, DTPicker и OlkDateControl)

Код:
Sub ДобавитьНовыйЛист()
    Dim Table1 As Range, Table2 As Range
    Dim YD As Double, TD As Double, D As Double, Reply As String, ReplyOk As Boolean, ShNewName As String
    '
    Set Table1 = Range([A5], [A5].End(xlDown))
    Set Table1 = Table1.Resize(, 13)    ' Диапазон_вчерашней_таблицы ' <-----!!!-------
    YD = [C1]    ' Вчерашняя_Дата_сегодня '
    TD = YD + 1
    ActiveSheet.Copy , ActiveSheet
    Set Table2 = [A5].Resize(Table1.Rows.Count, Table1.Columns.Count)    ' Диапазон_сегоднешней_таблицы '
    Application.ScreenUpdating = False
    [C1].ClearContents    ' Дата_сегодня '
    [D3] = YD    ' Дата_вчера '
    With Table2
        .Columns(5).ClearContents    ' Приход '
        .Columns(6).ClearContents    ' Продано '
        .Columns(7).ClearContents    'Другая_цена'
        .Columns(13).ClearContents    'Примечание'
        .Columns(4).Value = Table1.Columns(9).Value    ' Остатки_вчера=Остатки_сегодня ' ' <-----!!!-------
    End With
    ''''ShYesterday.Shapes("Кнопка_1").Delete
    Application.ScreenUpdating = True
    Do
        Reply = InputBox(String(5, vbCr) & "ВВЕДИТЕ ИМЯ НОВОГО ЛИСТА КАК ДАТУ:", "МАКСИМУМ", Format(TD, "DD.MM.YYYY"))
        If Trim(Reply) <> "" Then
            ReplyOk = (Reply Like "##.##.####") And IsDate(Reply)
            If ReplyOk Then
                D = CDate(Reply)
                If D <= YD Then
                    ReplyOk = False
                    MsgBox "Текущая дата не может быть вчерашней.", , "ОШИБОЧКА"
                Else
                    ShNewName = Format(D, "DD.MM.YYYY")
                    On Error Resume Next
                    ActiveSheet.Name = ShNewName
                    If Err = 0 Then
                        [C1] = D    ' Дата_сегодня '
                    Else
                        Err.Clear
                        ReplyOk = False
                        MsgBox "Лист '" & ShNewName & "' уже существует.", vbExclamation, "ОШИБОЧКА"
                    End If
                End If
            Else
                MsgBox String$(21, " "), vbExclamation, "ОШИБОЧКА"
            End If
        End If
    Loop Until ReplyOk
    Application.GoTo [A1]
End Sub

Последний раз редактировалось EducatedFool; 16.08.2011 в 22:40. Причина: пользуйтесь тегом CODE (кнопка #)
AKSENOV048 вне форума Ответить с цитированием
Старый 16.08.2011, 22:38   #2
EducatedFool
Программист VBA
СуперМодератор
 
Аватар для EducatedFool
 
Регистрация: 13.07.2008
Сообщений: 6,856
По умолчанию

Я ж вам уже ответил здесь: http://www.planetaexcel.ru/forum.php?thread_id=30620
Цитата:
Или лучше взять календарь из этой программы:
http://excelvba.ru/programmes/Fill_Invoice
Для этого перетащите модуль Date_and_Time и форму Form_SelectDate из моего файла в свой.


В этом случае ваш код будет таким:
Код:
...
Reply = Get_Date(Now)    ' выбор даты из календаря
...
EducatedFool вне форума Ответить с цитированием
Старый 16.08.2011, 23:02   #3
doober
Старожил
 
Аватар для doober
 
Регистрация: 02.05.2009
Сообщений: 3,907
По умолчанию

Плохо значит искали
проверять на вчера не надо.
ЗЫ:Не успел
Вложения
Тип файла: rar tmp1.rar (27.7 Кб, 18 просмотров)
Анализ,обработка данных Недорого
doober вне форума Ответить с цитированием
Старый 16.08.2011, 23:06   #4
AKSENOV048
Пользователь
 
Аватар для AKSENOV048
 
Регистрация: 03.08.2011
Сообщений: 74
По умолчанию

EducatedFool сразу не понял что к чему прикрепить, спасибо большое за пояснение! очень помогли, стало очень удобно!
Спасибо doober за ответ!
AKSENOV048 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
вставить в ячейку имя листа ElenaTro Microsoft Office Excel 7 16.03.2013 10:50
Узнать имя листа, если известно кодовое имя tae1980 Microsoft Office Excel 3 20.03.2011 21:57
Добыть имя листа gregory1b Microsoft Office Excel 4 09.12.2010 10:50
Имя листа Sensy Microsoft Office Excel 2 14.12.2009 17:23
Как получить имя листа? ABCOz Microsoft Office Excel 2 29.11.2009 15:37