. Почти все 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
Ну если ты такой поклонник красоты, то ищи красоту.