1

Тема: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

Доброго времени суток.
Проблема в следующем.
Есть некое .hta, на котором расположено поле для ввода даты, предположим в формате дд.мм.гггг. При загрузке ставится текущая дата.
Есть пользователи, которые будут дату в это поле вводить(менять) и потом нажимать на кнопку.
Очень хочется сделать это поле readonly, и чтобы при при клике выпадал календарик, где дата выбирается. Это поможет застраховаться от некорректного ввода даты.
Искал. Много. DatePicker-ов нашёл кучу, но все они для Access или прочего.
Хотелось бы библиотечку, потом "Set calendar = CreateObject("calen.dar")" и "Sub DateField_OnClick calendar.show End Sub"
Последние полторы недели поисков убедили меня в том, что сие так и останется мечтой.
Единственное, наиболее близкое решение, это использование Calendar.js http://www.royalcrest.co.il/users/kozin … rinternet. (эту ссылку нашёл только что, пробовал же с другим Calendar.js, но думаю суть одна и та же), но у меня с js довольно туго, а проще говоря вообще никак...
Может у кого есть хоть какое-нибудь решение?
Фиг с ним, можно и с js, только желательно, чтобы код был внутри HTA, а не во внешнем файле.

З.ы.
Это мой первый пост и посему спешу поблагодарить script-coding.com за помощь в решении кучи проблем и за svcsvc.dll в частности. Что бы я без неё делал...

"Единство,- возвестил оракул наших дней: -
Быть может спаяно железом лишь и кровью"…
Но мы попробуем спаять его любовью,-
А там увидим, что прочней…    (Ф. Тютчев)       Тут хорошая справка по vbs.

2

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

Хотелось бы услышать, чем не устроил обычный «Microsoft Date and Time Picker Control»?

3 (изменено: MikeSh, 2008-12-06 21:54:59)

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

Пожалуйста, будте добры, маленький кусочек кода...

В том плане, что устроит всё, только бы знать как...

"Единство,- возвестил оракул наших дней: -
Быть может спаяно железом лишь и кровью"…
Но мы попробуем спаять его любовью,-
А там увидим, что прочней…    (Ф. Тютчев)       Тут хорошая справка по vbs.

4

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

К примеру, так у меня отображает

<HTML>
    <HEAD>
        <HTA:APPLICATION APPLICATIONNAME="DTPicker Demo" />
    </HEAD>
    <BODY>
        <P>
            <OBJECT classid="clsid:20DD1B9E-87C4-11D1-8BE3-0000F8754DA1" id="DTPicker1">
            </OBJECT>
        </P>
    </BODY>
</HTML>

5

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

Не алё...
Вставил сие в 1.hta, запустил.
Имею окошко, белое, с маленьким квадратом в верхнем правом углу. И всё.
Может, нужна библиотека какая?

"Единство,- возвестил оракул наших дней: -
Быть может спаяно железом лишь и кровью"…
Но мы попробуем спаять его любовью,-
А там увидим, что прочней…    (Ф. Тютчев)       Тут хорошая справка по vbs.

6

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

Есть такой раздел в реестре?

HKEY_CLASSES_ROOT\CLSID\{20DD1B9E-87C4-11D1-8BE3-0000F8754DA1}

Если нет — ищем, качаем, регистрируем реализующую библиотеку mscomct2.ocx, он же «Microsoft Common Controls 2 ActiveX Control DLL». У меня версия файла dll — 6.0.88.4. Насколько это будет легитимно — не скажу, поскольку не знаю, в комплекте чего именно она поставляется и по какой лицензии.

7

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

Microsoft Calendar Control (Библиотека MSCAL.OCX) можно
попробовать задействовать например следующим образом:


<!--Пример использования Microsoft Calendar Control-->
<META HTTP-EQUIV=Content-Type content='text/html;charset=windows-1251'>
<HTML>
<TITLE>Пример Microsoft Calendar Control</TITLE>

<HEAD>
    <STYLE TYPE='text/css'>
        BODY        {background-color: #c0c0c0;}
        PRE        {border: 1px; border-style: solid; font-family: Lucida Console; font-size: 20px; background-color: #b5bcf2;}
        OBJECT        {border: 1px solid red; position: relative;}
    </STYLE>
    
    <HTA:APPLICATION
        ID="m4"
        APPLICATIONNAME="MSACAL"    
     />
</HEAD>

<BODY SCROLL="NO">
    <INPUT TYPE='TEXT' ID='dateInp' style='width: 200; font-family: Verdana;font-weight: 700;'>
    <INPUT TYPE='BUTTON' VALUE='Ввод даты' ID='dateInv'><BR>
    <OBJECT ID="CalendarObject"></OBJECT><BR>
    <PRE>
        Щелкните по кнопке 'Ввод даты' 
        чтобы отобразить календарь и установите дату.

        Повторный щелчок по этой же кнопке приведет
        к скрытию календаря.
    </PRE>

<SCRIPT>
var IsVisible    =false
var dt        =new Date
//-------------------------------------------------------------------
with (CalendarObject)
{
//Установка свойств объекта Календарь
    classid="CLSID:8E27C92B-1264-101C-8A2F-040224009C02"
    style.height=0
    style.width=0
    BackColor=16436877
    ShowDays=1
    today()
    dateInp.value=Day+'.'+Month+'.'+Year
}
//-------------------------------------------------------------------
function CalendarObject_AfterUpdate_js()
{
//Реакция Календаря на изменения даты
//исходит из области VBScript где обрабатывается
//событие _AfterUpdate
    with (CalendarObject)
    {
        dt.setDate(Day)
        dt.setMonth(Month-1)
        dt.setYear(Year)
        dateVal=Day+'.'+Month+'.'+Year
    }
        dateInp.value=dateVal
}
//-------------------------------------------------------------------
function dateInv.onclick()
{
//Установка состояния Календаря,в зависимости от
//нажатия кнопки
    if (!IsVisible)
    {
        with (CalendarObject)
        {
            style.height=200
            style.width=200
            today()
        }
        IsVisible=true
    }
    else
    {
        with (CalendarObject)
        {
            style.height=0
            style.width=0
        }
        IsVisible=false
        alert(dt)
    }
}
</SCRIPT>

<SCRIPT Language="VBScript">
    Sub CalendarObject_AfterUpdate()
        CalendarObject_AfterUpdate_js()
    End Sub

</SCRIPT>
</BODY>
</HTML>

8

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

Я предпочитаю именно DTPicker, поскольку он позволяет как выбирать, так и вводить руками (с верификацией). А руками — без мыши и быстрее. Особенно это критично при однотипном монотонном вводе.

9

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

Обожаю этот форум!
Оба примера заработали!

Однако вопросы
1)  alexii, как обращаться к этому обьекту, читать из него? В том плане, что ежели есть <input type="text" name=a>, то текст в нём = a.value, а здесь?

2) Poltergeyst, этот календарь (заработал, кстати, сразу, без сторонней библиотеки) может всплывать или надо ресайзить окно? И ещё, код там js, как бы его рядом с vb приладить в одном hta?

"Единство,- возвестил оракул наших дней: -
Быть может спаяно железом лишь и кровью"…
Но мы попробуем спаять его любовью,-
А там увидим, что прочней…    (Ф. Тютчев)       Тут хорошая справка по vbs.

10 (изменено: MikeSh, 2008-12-06 23:46:36)

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

1 вопрос снят, разобрался.
2 вопрос снят, увидел.

"Единство,- возвестил оракул наших дней: -
Быть может спаяно железом лишь и кровью"…
Но мы попробуем спаять его любовью,-
А там увидим, что прочней…    (Ф. Тютчев)       Тут хорошая справка по vbs.

11 (изменено: Poltergeyst, 2008-12-07 12:19:20)

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

Вот еще один из возможных вариантов использования Microsoft Calendar Control,на этот раз с применением модального диалога.

Нужно создать HTA файл с произвольным именем и следующим содержимым:

<!--Пример использования Microsoft Calendar Control-->
<!--Основной HTA-->
<META HTTP-EQUIV=Content-Type content='text/html;charset=windows-1251'>
<HTML>
<TITLE>Пример Microsoft Calendar Control</TITLE>

<HEAD>
<STYLE TYPE='text/css'>
    BODY        {background-color: white;}
    PRE        {border: 1px; border-style: solid; font-family: Lucida Console; font-size: 14px; background-color: #b5bcf2;}
    INPUT        {border: 1px solid olive;}    
</STYLE>
    
<HTA:APPLICATION
    ID="m4"
    APPLICATIONNAME="MSACAL"    
 />
</HEAD>

<BODY SCROLL="NO">
<INPUT TYPE='TEXT' ID='dateInp' style='width: 200; font-family: Verdana;font-weight: 700;'>
<INPUT TYPE='BUTTON' VALUE='Ввод даты' ID='dateInv'><BR>
<PRE>
    Щелкните по кнопке 'Ввод даты' 
    чтобы отобразить календарь и установите дату.
</PRE>

<SCRIPT>
dt=new Date
//-------------------------------------------------------------------
dateInp.readOnly=true
dateInp.value=dt.getDate()+'.'+eval(dt.getMonth()+1)+'.'+dt.getYear()
//-------------------------------------------------------------------
function dateInv.onclick()
{
//Вызов модального диалога Календаря
    ret=window.showModalDialog('mscal.htm','')
    if (ret){dateInp.value=ret}
    
}
//-------------------------------------------------------------------
</SCRIPT>
</BODY>
</HTML>

Далее,создать файл со строго заданным именем mscal.htm и разместить
его в одном каталоге с основным HTA.Содержимое mscal.htm:

<!--Пример использования Microsoft Calendar Control-->
<!--Файл модального диалога mscal.htm-->
<META HTTP-EQUIV=Content-Type content='text/html;charset=windows-1251'>
<HTML>
<TITLE>Microsoft Calendar Control</TITLE>
<HEAD>
<STYLE TYPE='text/css'>
    OBJECT        {border: 1px solid red; position: relative;}
    INPUT        {border: 1px solid blue; width: 90}    
</STYLE>
</HEAD>

<BODY SCROLL="NO">
    <OBJECT ID="CalendarObject"></OBJECT><BR>
    &nbsp<BR>
    &nbsp<INPUT TYPE='BUTTON' VALUE='Ok' ID='dateOk'>
    &nbsp<INPUT TYPE='BUTTON' VALUE='Cancel' ID='dateCancel'>

<SCRIPT>
dialogHeight    =320/16
dialogWidth    =320/16
//-------------------------------------------------------------------
with (CalendarObject)
{
//Установка свойств объекта Календарь
    classid="CLSID:8E27C92B-1264-101C-8A2F-040224009C02"
    style.height    =220
    style.width    =300
    BackColor    =16436877
    ShowDays    =1
    today()
}
//-------------------------------------------------------------------
function CalendarObject_AfterUpdate_js()
{
//Только для совместимости с VBScript
return
}
//-------------------------------------------------------------------
function dateOk.onclick()
{
//Кнопка Ok
    with (CalendarObject)
    {
        dateVal=Day+'.'+Month+'.'+Year
    }
        returnValue=dateVal
    if (!CalendarObject.Day){returnValue=''}
    close()
}
//-------------------------------------------------------------------
function dateCancel.onclick()
{
//Кнопка Отмена
    returnValue=''
    close()
}
//-------------------------------------------------------------------
</SCRIPT>

<SCRIPT Language="VBScript">
' Обработчик события AfterUpdate.Необходим,т.к 
' Календарь оптимизирован под VBScript
    Sub CalendarObject_AfterUpdate()
        CalendarObject_AfterUpdate_js()
    End Sub
</SCRIPT>
</BODY>
</HTML>

Запустить HTA.

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Вызывать функции JavaScript из области VBScript в пределах одного HTA,HTML документа можно следующим образом:

<META HTTP-EQUIV=Content-Type content='text/html;charset=windows-1251'>
<HTML>
<BODY SCROLL="NO">

<SCRIPT Language="JavaScript">

function callWorld()
{
alert('hello world')
}
</SCRIPT>

<SCRIPT Language="VBScript">
'Вызов функции JavaScript из области VBS
callWorld()
</SCRIPT>
</BODY>
</HTML>

А вот с вызовом VBScript функций из области JavaScript дело обстоит несколько
более сложно:

<META HTTP-EQUIV=Content-Type content='text/html;charset=windows-1251'>
<HTML>
<BODY SCROLL="NO">

<SCRIPT Language="JavaScript">
//Вызывающая функция JavaScript
    function callJsWorld(param)
        {return param}
</SCRIPT>

<SCRIPT Language="VBScript">
'Основная функция VBScript
    Function callWorld()
        MsgBox "Hello World",vbExclamation+vbSystemModal,"call"
        callWorld=0
    End Function
</SCRIPT>

<SCRIPT Language="JavaScript">
//Вызов вызывающей функции
//с передачей основной функции
//как параметра
    callJsWorld(callWorld())
</SCRIPT>
</BODY>
</HTML>

12

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

Предлагаю создать в Коллекции тему "HTA: интерактивный ввод даты" и зафиксировать там все приведённые в этой ветке примеры.

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

13

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

Примеры добавлены в Коллекцию.
http://www.forum.script-coding.com/view … hp?id=2552

14

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

Огромное спасибо!
Начать, чёль, JavaScript изучать...

"Единство,- возвестил оракул наших дней: -
Быть может спаяно железом лишь и кровью"…
Но мы попробуем спаять его любовью,-
А там увидим, что прочней…    (Ф. Тютчев)       Тут хорошая справка по vbs.

15

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

А кто нибудь знает как сделать так, чтобы функция toString() возвращала результат в заданном формате?
Используется mscomct2.ocx, он же «Microsoft Common Controls 2 ActiveX Control DLL»

Например

<OBJECT classid="clsid:20DD1B9E-87C4-11D1-8BE3-0000F8754DA1" id="DTPicker" width="100" height="25">
</OBJECT>
...
alert(DTPicker.toString());

выводит в формате "MM/DD/YYYY"
а мне надо "DD.MM.YYYY"

16

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

Может, просто заменить слэши на точки?

alert(DTPicker.toString().replace(/\//g, "."));

17

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

Надо еще дату с месяцем местами поменять

выводит в формате "MM/DD/YYYY"
а мне надо "DD.MM.YYYY"

хотелось бы сделать это стандартным способом.
должен же где-то формат вывода прописываться

18

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

Можно так:

D = new Date(DTPicker.toString());

alert(D.getDate() + "." + (D.getMonth()+1) + "." + D.getFullYear());

19

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

Тоже самое можно получить без использования Date

alert(DTPicker.Day + "." + DTPicker.Month + "." + DTPicker.Year)

но они возвращают не совсем в формате DD.MM.YYYY, они не дописывают нули к дню и месяцу
т.е. если дата "1.5.2009", то они покажут "1.5.2009", а необходимо "01.05.2009"

можно конечно вручную проверять длину чисел и подписывать нули, но хочется более красивое решение

Должна ведь быть возможность задать формат для функции toString()

20

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

volkov888 пишет:

Должна ведь быть возможность задать формат для функции toString()

Кому должна-то? Ну если ты такой поклонник красоты, то ищи красоту.

21

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

Не могу добиться вызова 2-х диалогов ввода даты.
Видимо совсем не хватает знаний в JS, но как не бьюсь с примером:
http://forum.script-coding.com/viewtopic.php?id=2552

Добавил еще кнопку:

 <INPUT TYPE='TEXT' ID='dateInp' style='width: 200; font-family: Verdana;font-weight: 700;'>
<INPUT TYPE='BUTTON' VALUE='Ввод даты' ID='dateInv'><BR>
<INPUT TYPE='TEXT' ID='dateOut' style='width: 200; font-family: Verdana;font-weight: 700;'>
<INPUT TYPE='BUTTON' VALUE='Ввод даты' ID='dateOut'><BR>

Изменил переменные. Событие function dateOut.onclick() не наступает.
Подскажите как получить интервал дат?

Автоматизирую торговлю. Не 1С

22

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

Если где подымалось, то просьба тыкнуть.
Создал я СОМ объект
Dim obj : Set obj = CreateObject ("MSComCtl2.DTPicker.2")
А вот как с ним работать не пойму.  Методов для запуска не могу найти. Подозреваю что нужно его вставлять на какое то окно чтобы увидеть.
Но вопрос как создать это окно?
Помогите пожалуйста добрым советом.
Язык vbScript.

23

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

Используйте програму Microsoft ActiveX Control Pad
http://msdn.microsoft.com/en-us/library/ms968493
Там вы найдет все элементы.

Автоматизирую торговлю. Не 1С

24

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

Скачал, попробовал. Все равно не очень ясно как этот HTML прилепить к vbs скрипту и вытащить все данные из него.

25

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

2 Pix: Всё упирается в то, что у WSH нет встроенных средств для отображения интерфейса. Т.е создав через CreateObject объект, Вы банально не можете его увидеть. Хотя он есть. . Почти все Activex которые имеют визуальное оформление (за исключением тех в которые уже вшито отображение формы например), требуют форму для отображения себя (окно "подложку" скажем так). Для этих целей на форуме была разработана самодельная функция отображения окон CreateWindow. ссылка. Она позволяет создать некое подобие оконного интерфейса за счёт управления отдельным HTA окном. Вот в нём то и можно разместить Activex календаря, которым в дальнейшем можно управлять.

Не пугайтесь количества кода, которое идёт дальше в примере. Больше половины занимает как раз сама функция CreateWindow. Ну и огромную долю конечно составляет HTML код формы в которой находится календарь. )

пример


Option Explicit
Dim window, document, windowClosed, SelectedDate
'Создаём окно по нужному нам образу и подобию )
Set window = CreateWindow("<html><head><title>Выбор даты</title></head><body scroll='no' style='padding:0;margin:0;'><table style='width:100%;height:100%' cellpadding=0 cellspacing=0><tr><td height=100%><object id='calendar' classid='clsid:8E27C92B-1264-101C-8A2F-040224009C02' style='width:100%;height:100%;'></object></td></tr><tr><td><button id='btnSelect' style='width:100%;'>Выбрать дату</button></td></tr></table></body></html>","border=dialog maximizeButton=no minimizeButton=no",-1,-1,300,300)
'Получаем доступ к внутреннему документу окна
set document = window.document

'Подключаем событие закрытия окна к нашей процедуре
document.body.onunload = getref("window_onunload")

'Подключаем нажатие на кнопку к той же процедуре закрытия окна (хотя можно было бы и к другой)
window.btnSelect.onclick = getref("window_onunload")

'Событие выгрузки формы
Sub window_onunload()
    'Запоминаем выбранную дату в переменную
    SelectedDate = window.calendar.Value
    'Закрываем окошко, дабы не мозолило глаза
    window.close()
    'Выставляем флаг для цикла
    windowClosed = True
End Sub

'Запускаем цикл, чтобы скрипт не выгружался раньше времени
Do
    WScript.Sleep 100
Loop Until windowClosed

MsgBox SelectedDate

Function CreateWindow(content,features,x,y,width,height)
    On Error Resume Next
    Dim ShellWindows,ShellWindow,CodeForLinking,wshExec,form_id,id,i,document,window
    Set CreateWindow = Nothing
    Set ShellWindows = CreateObject("Shell.Application").Windows: Randomize: id = Clng(Rnd*100000)
    CodeForLinking = "<script>moveTo(-1000,-1000);resizeTo(0,0);</script>" &_
    "<hta:application " & features & " />" & _
    "<object id=" & id & " style='display:none' classid='clsid:8856F961-340A-11D0-A96B-00C04FD705A2' viewastext><param name=RegisterAsBrowser value=1></object>"
    Set wshExec = CreateObject("WScript.Shell").Exec("mshta about:""" & CodeForLinking & """")
    For i=1 to 1000
        For Each ShellWindow in ShellWindows: form_id = Clng(ShellWindow.id)
            if form_id = id Then
                Set document = ShellWindow.container:
                Set window = document.parentWindow
                document.open: window.execScript "var Host": Set window.Host = me
                document.write content: document.close
                if x <= 0 Then x = (window.screen.width - width) / 2
                if y <= 0 Then y = (window.screen.height - height) / 2
                window.execScript "document.onkeydown = function(){if(event.keyCode == 116){return false}};" &_
                "setInterval('var e;try{Host.WScript}catch(e){close()}',100);moveTo(" & x & "," & y & ");resizeTo(" & width & "," & height & ")"
                Set CreateWindow = window
                Exit Function
            End if
        Next
    Next
    wshExec.Terminate()
End Function
Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !

26

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

Спасибо. Ура!

27

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

А если нужно сделать автоматический перерасчет формы
(сразу после ввода пользователем в DTPicker новой даты),
то нужно привязать событие EVENT='Change'
к функции - обработчику при помощи конструкции SCRIPT FOR
Чтобы понять о чем речь - можете скачать и изучить тест DTPicker в HTA-форме

28

Re: HTA+VBS: Ввод даты с использованием календаря (DatePicker)

У меня тоже была однажды задача ввода даты в HTA с использованием календаря. Но без объектов, классов и контролов. Кому интересно, ниже пример:

<html>
<head>
<title>HTA Calendar</title>
<HTA:APPLICATION 
     ID="objTest" 
     APPLICATIONNAME="Calendar by OldBoa"
     SCROLL="no"
     SINGLEINSTANCE="yes"
>
</head>

<SCRIPT LANGUAGE="VBScript">
current_date = date
Sub Window_Onload
    Display_Calendar(current_date)
End Sub
Sub Display_Calendar(c_date)
    DayOfMonth = CDate("01." & Month(c_date) & "." & Year(c_date))
    strHTML = strHTML & "<input id=pryear title='-year' class='button' type='button' value='<<' name='pryear' onClick=" & Chr(34) & "changedate 'yyyy','-1'" & Chr(34) & ">"
    strHTML = strHTML & "<input id=prmon title='-month' class='button' type='button' value='<' name='prmon' onClick=" & Chr(34) & "changedate 'm','-1'" & Chr(34) & ">"
    strHTML = strHTML & "<span id='cur_date'></span>"
    strHTML = strHTML & "<input id=nxmon title='+month' class='button' type='button' value='>' name='nxmon' onClick=" & Chr(34) & "changedate 'm','1'" & Chr(34) & ">"
    strHTML = strHTML & "<input id=nxyear title='+year' class='button' type='button' value='>>' name='nxyear' onClick=" & Chr(34) & "changedate 'yyyy','1'" & Chr(34) & ">"
    strHTML = strHTML & "<br><TABLE border><TR bgColor='silver'><TD>#</TD><TD>Пн</TD><TD>Вт</TD><TD>Ср</TD><TD>Чт"
    strHTML = strHTML & "</TD><TD>Пт</TD><TD>Сб</TD><TD>Вс</TD></TR><TR><TD bgColor='silver'><span id='onedate' onClick=" & Chr(34) & "oneclick('" & DayOfMonth & "')" & Chr(34) & " onmouseover=" & Chr(34) & "cursor('hand')" & Chr(34) & " onmouseout=" & Chr(34) & "cursor('default')" & Chr(34) & ">" 
    strHTML = strHTML & DatePart("ww",DayOfMonth,vbMonday) & "</span></TD>"
    FirstWeekday = Weekday(DayOfMonth,vbMonday) - 1
    For i = 1 To FirstWeekday
        strHTML = strHTML & "<TD><font color='gray' size='1'><span id='onedate' onClick=" & Chr(34) & "oneclick('" & DayOfMonth & "')" & Chr(34) & " onmouseover=" & Chr(34) & "cursor('hand')" & Chr(34) & " onmouseout=" & Chr(34) & "cursor('default')" & Chr(34) & ">" & DatePart("d",DateAdd("d",-(Weekday(DayOfMonth,vbMonday) - i),DayOfMonth)) & "</font></TD>"
    Next
    strHTML = strHTML & "<TD><span id='onedate' title=" & Chr(34) & DayOfMonth & Chr(34) & " onClick=" & Chr(34) & "oneclick('" & DayOfMonth & "')" & Chr(34) & " onmouseover=" & Chr(34) & "cursor('hand')" & Chr(34) & " onmouseout=" & Chr(34) & "cursor('default')" & Chr(34) & ">" & DatePart("d",DayOfMonth) & "</span></TD>"
    Do While Month(DayOfMonth) = Month(c_date)
        NumDay = Day(DayOfMonth) + FirstWeekday
        DayOfMonth = DateAdd("d","1",DayOfMonth)
        If NumDay = 7 Or NumDay = 14 Or NumDay = 21 Or NumDay = 28 Or NumDay = 35 Then
            strHTML = strHTML & "</TR><TR>"
            If DatePart("d",DayOfMonth) <> 1 Then
                strHTML = strHTML & "<TD bgColor='silver'><span id='onedate' onClick=" & Chr(34) & "oneclick('" & DayOfMonth & "')" & Chr(34) & " onmouseover=" & Chr(34) & "cursor('hand')" & Chr(34) & " onmouseout=" & Chr(34) & "cursor('default')" & Chr(34) & ">" & DatePart("ww",DayOfMonth,vbMonday) & "</span></TD>"
            End If
        End If
        If DatePart("d",DayOfMonth) <> 1 Then
            strHTML = strHTML & "<TD><span id='onedate' title=" & Chr(34) & DayOfMonth & Chr(34) & " onClick=" & Chr(34) & "oneclick('" & DayOfMonth & "')" & Chr(34) & " onmouseover=" & Chr(34) & "cursor('hand')" & Chr(34) & " onmouseout=" & Chr(34) & "cursor('default')" & Chr(34) & ">" & DatePart("d",DayOfMonth) & "</span></TD>"
        Else
            If Weekday(DayOfMonth,vbMonday) <> 1 Then
                strHTML = strHTML & "<TD><font color='gray' size='1'><span id='onedate' onClick=" & Chr(34) & "oneclick('" & DayOfMonth & "')" & Chr(34) & " onmouseover=" & Chr(34) & "cursor('hand')" & Chr(34) & " onmouseout=" & Chr(34) & "cursor('default')" & Chr(34) & ">" & DatePart("d",DayOfMonth) & "</font></TD>"
            End If
        End If
    Loop
    If Weekday(DayOfMonth,vbMonday) <> 1 Then
        For i = 1 To 7 - Weekday(DayOfMonth,vbMonday)
            strHTML = strHTML & "<TD><font color='gray' size='1'><span id='onedate' onClick=" & Chr(34) & "oneclick('" & DayOfMonth & "')" & Chr(34) & " onmouseover=" & Chr(34) & "cursor('hand')" & Chr(34) & " onmouseout=" & Chr(34) & "cursor('default')" & Chr(34) & ">" & DatePart("d",DateAdd("d",i,DayOfMonth)) & "</font></TD>"
        Next
    End If
    strHTML = strHTML & "</TR></TABLE>"
    calendar.InnerHTML = strHTML
    cur_date.InnerHTML = MonthName(Month(c_date)) & " " & Year(c_date)
End Sub
Sub changedate(t,v)
    current_date = DateAdd(t,v,current_date)
    Display_Calendar(current_date)
End Sub
Sub cursor(name)
    document.body.style.cursor = name
End Sub
Sub oneclick(par)
    par = DateAdd("d",1 - Weekday(par,vbMonday),par) 
    par = Year(par) & "-" & NeedNULL(Month(par)) & "-" & NeedNULL(Day(par))
    dateclick.InnerHTML = par
End Sub
Sub Savehtml
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    objFSO.CreateTextFile("test.htm")
    Set objFile = objFSO.OpenTextFile("test.htm", 2)
    objFile.WriteLine calendar.InnerHTML
    objFile.Close
    msgbox "Сохранено в test.html"
End Sub
Function NeedNULL(par)
    If Len(par) < 2 Then
        NeedNULL = "0" & par
    Else
        NeedNULL = par
    End If
End Function
</SCRIPT>

<body>
<input id="SaveButton" class="button" type="button" value="Save to html" name="SaveButton"  onClick="Savehtml"><br>
<span id="calendar"></span>
<span id="dateclick"></span>
</body>