jQuery UIのDatepickerをVBAから使用するサンプル

ホーム
Office関連, Excel, Word
jQuery UIのDatepickerをVBAから使用するサンプル

Office関連

2014.01.29

jQuery UIのDatepickerをVBAから使用するサンプル

2014/1/31 追記：
Internet ExplorerのオートメーションではなくUserForm上のWebBrowserコントロールを使う方法も考えてみました。

・「カレンダーから日付入力」をUserFormに移植してみました。
//www.ka-net.org/blog/?p=3991

私が作成したOffice 用アプリ「カレンダーから日付入力」をVBA用に作ってほしいとの要望がありましたので、処理を考えてみました。

「カレンダーから日付入力」ではjQuery UIプラグインのDatepickerを利用していて、この機能をVBAから呼び出すには、Internet Explorerを利用するのが簡単だろうと思います。

早速考えたコードが下記になります。

※ コード中にも書いていますが、コードはThisWorkbookやThisDocumentといったクラスモジュールに貼り付ける必要があります。また、事前に[Microsoft HTML Object Library]と[Microsoft Internet Controls]の2つを参照しておく必要があります。

'※ ThisWorkbookやThisDocumentといったクラスモジュールにコードを記述
'※ [Microsoft HTML Object Library][Microsoft Internet Controls]要参照

Option Explicit

Private WithEvents IE As InternetExplorer
Private WithEvents iptResult As MSHTML.HTMLInputTextElement

Public Sub DisplayDatepicker()
'カレンダー(Datepicker)表示
  Dim d As MSHTML.HTMLDocument
  Dim mtaChar As MSHTML.HTMLMetaElement
  Dim mtaCom As MSHTML.HTMLMetaElement
  Dim lnkCSS As MSHTML.HTMLLinkElement
  Dim stlMain As MSHTML.HTMLStyleElement
  Dim divDP As MSHTML.HTMLDivElement
  Dim scrjQuery As MSHTML.HTMLScriptElement
  Dim scrjQueryUI As MSHTML.HTMLScriptElement
  Dim scrjQueryDP As MSHTML.HTMLScriptElement
  Dim scrHolidayChk As MSHTML.HTMLScriptElement
  Dim scrMain As MSHTML.HTMLScriptElement
  Dim css As String
  
  If Not IE Is Nothing Then Exit Sub
  Set IE = New InternetExplorer
  With IE
    .AddressBar = False
    .MenuBar = False
    .StatusBar = False
    .Toolbar = False
    .Navigate "about:blank"
    .Width = 350
    .Height = 300
    .Visible = True
    While .Busy Or .readyState <> READYSTATE_COMPLETE
      DoEvents
    Wend
    Set d = .Document
    
    'Charset設定
    Set mtaChar = d.createElement("meta")
    mtaChar.Charset = "UTF-8"
    d.getElementsByTagName("head")(0).appendChild mtaChar
    
    'X-UA-Compatible設定
    Set mtaCom = d.createElement("meta")
    mtaCom.httpEquiv = "X-UA-Compatible"
    mtaCom.Content = "IE=Edge"
    d.getElementsByTagName("head")(0).appendChild mtaCom
    
    'jQuery UI用CSS読み込み
    Set lnkCSS = d.createElement("link")
    lnkCSS.rel = "stylesheet"
    lnkCSS.href = "http://code.jquery.com/ui/1.10.4/themes/flick/jquery-ui.css"
    d.getElementsByTagName("head")(0).appendChild lnkCSS
    
    'CSS設定
    Set stlMain = d.createElement("style")
    stlMain.Type = "text/css"
    css = "body {" & vbCrLf
    css = css & "    margin:0;" & vbCrLf
    css = css & "    padding:0;" & vbCrLf
    css = css & "    font-family:Arial,sans-serif;" & vbCrLf
    css = css & "}" & vbCrLf
    css = css & ".ui-datepicker {" & vbCrLf
    css = css & "    font-size:100%;" & vbCrLf
    css = css & "}" & vbCrLf
    css = css & ".date-holiday .ui-state-default {" & vbCrLf
    css = css & "    background-image:none;" & vbCrLf
    css = css & "    background-color:#FF9999;" & vbCrLf
    css = css & "}" & vbCrLf
    css = css & ".date-saturday .ui-state-default {" & vbCrLf
    css = css & "    background-image:none;" & vbCrLf
    css = css & "    background-color:#66CCFF;" & vbCrLf
    css = css & "}"
    stlMain.StyleSheet.cssText = css
    'stlMain.disabled = False
    'stlMain.styleSheet.addRule "body", "background-color:blue"
    d.getElementsByTagName("head")(0).appendChild stlMain
    
    '結果取得用テキストボックス設定
    Set iptResult = d.createElement("input")
    iptResult.ID = "iptResult"
    iptResult.Style.Display = "none"
    d.body.appendChild iptResult
    
    'Datepicker用Div設定
    Set divDP = d.createElement("div")
    divDP.ID = "datepicker"
    d.body.appendChild divDP
    
    'jQuery読み込み
    Set scrjQuery = d.createElement("script")
    scrjQuery.src = "http://code.jquery.com/jquery-1.10.2.js"
    d.getElementsByTagName("head")(0).appendChild scrjQuery
    
    'jQuery UI読み込み
    Set scrjQueryUI = d.createElement("script")
    scrjQueryUI.src = "http://code.jquery.com/ui/1.10.4/jquery-ui.js"
    d.getElementsByTagName("head")(0).appendChild scrjQueryUI
    
    'Datepicker読み込み
    Set scrjQueryDP = d.createElement("script")
    scrjQueryDP.src = "http://ajax.googleapis.com/ajax/libs/jqueryui/1/i18n/jquery.ui.datepicker-ja.min.js"
    d.getElementsByTagName("head")(0).appendChild scrjQueryDP
    
    '祝日判定スクリプト読み込み
    Set scrHolidayChk = d.createElement("script")
    scrHolidayChk.Text = GetHolidayChkScript()
    d.getElementsByTagName("head")(0).appendChild scrHolidayChk
    
    'JavaScript設定
    Set scrMain = d.createElement("script")
    Dim code As String
    code = "$(function(){" & vbCrLf
    code = code & "    $('#datepicker').datepicker({" & vbCrLf
    code = code & "        beforeShowDay: function(date) {" & vbCrLf
    code = code & "            var result;" & vbCrLf
    code = code & "            var dd = date.getFullYear() + '/' + (date.getMonth() + 1) + '/' + date.getDate();" & vbCrLf
    code = code & "            var hName = ktHolidayName(dd);" & vbCrLf
    code = code & "            if(hName != '') {" & vbCrLf
    code = code & "                result = [true, 'date-holiday', hName];" & vbCrLf
    code = code & "            } else {" & vbCrLf
    code = code & "                switch (date.getDay()) {" & vbCrLf
    code = code & "                    case 0: //日曜日" & vbCrLf
    code = code & "                        result = [true, 'date-holiday'];" & vbCrLf
    code = code & "                        break;" & vbCrLf
    code = code & "                    case 6: //土曜日" & vbCrLf
    code = code & "                        result = [true, 'date-saturday'];" & vbCrLf
    code = code & "                        break;" & vbCrLf
    code = code & "                    default:" & vbCrLf
    code = code & "                        result = [true];" & vbCrLf
    code = code & "                        break;" & vbCrLf
    code = code & "                }" & vbCrLf
    code = code & "            }" & vbCrLf
    code = code & "            return result;" & vbCrLf
    code = code & "        }," & vbCrLf
    code = code & "        onSelect: function(dateText, inst) {" & vbCrLf
    code = code & "            $('#iptResult').val(dateText).trigger('click');" & vbCrLf
    code = code & "        }" & vbCrLf
    code = code & "    });" & vbCrLf
    code = code & "});"
    scrMain.Text = code
    'd.getElementsByTagName("head")(0).appendChild scrMain
    d.body.appendChild scrMain
  End With
End Sub

Private Function iptResult_onclick() As Boolean
'日付選択時に発生するイベント
  Debug.Print iptResult.Value
End Function

Private Sub CleanUp()
  Set iptResult = Nothing
  Set IE = Nothing
End Sub

Private Sub IE_OnQuit()
  CleanUp
  Debug.Print "IE_OnQuit" '確認用
End Sub

Private Function GetHolidayChkScript() As String
'祝日判定スクリプト取得
'
'※角田さん作の「日本の祝日判定ロジック」
'　http://www.h3.dion.ne.jp/~sakatsu/holiday_logic.htm#JS
'　をBase64エンコードして変数に格納→使用時にデコード

  Dim code As String
  
  code = "PCEtLQ0KLy9fL18vXy9fL18vXy9fL18vXy9fL18vXy9fL18vXy9fL18vXy9fL18vXy9fL18vXy9fL18vXy9fL18vXy9fL18vDQov"
  code = code & "L18vDQovL18vIENvcHlSaWdodChDKSBLLlRzdW5vZGEoQWRkaW5Cb3gpIDIwMDEgQWxsIFJpZ2h0cyBSZXNlcnZlZC4NCi8vXy8g"
  code = code & "KCBodHRwOi8vd3d3LmgzLmRpb24ubmUuanAvfnNha2F0c3UvaW5kZXguaHRtICkNCi8vXy8NCi8vXy8g44GT44Gu56Wd5pel5Yik"
  code = code & "5a6a44Kz44O844OJ44Gv44CORXhjZWw6a3TplqLmlbDjgqLjg4njgqTjg7PjgI/jgafkvb/nlKjjgZfjgabjgYTjgosNCi8vXy8g"
  code = code & "77y277yi77yh44Oe44Kv44Ot44KSW0phdmFTY3JpcHRd44Gr56e75qSN44GX44Gf44KC44Gu44Gn44GZ44CCDQovL18vIOOBk+OB"
  code = code & "rumWouaVsOOBp+OBr+OAge+8ku+8kO+8kO+8l+W5tOaWveihjOOBruaUueato+elneaXpeazlSjmmK3lkozjga7ml6Up44G+44Gn"
  code = code & "44KSDQovL18vIOOCteODneODvOODiOOBl+OBpuOBhOOBvuOBmSjvvJnmnIjjga7lm73msJHjga7kvJHml6XjgpLlkKvjgoAp44CC"
  code = code & "DQovL18vDQovL18vICgqMSnjgZPjga7jgrPjg7zjg4njgpLlvJXnlKjjgZnjgovjgavlvZPjgZ/jgaPjgabjga/jgIHlv4XjgZrj"
  code = code & "gZPjga7jgrPjg6Hjg7Pjg4jjgoINCi8vXy8g5LiA57eS44Gr5byV55So44GZ44KL5LqL44Go44GX44G+44GZ44CCDQovL18vICgq"
  code = code & "Minku5bjgrXjgqTjg4jkuIrjgafmnKzjg57jgq/jg63jgpLnm7TmjqXlvJXnlKjjgZnjgovkuovjga/jgIHjgZTpgaDmha7poZjj"
  code = code & "gYTjgb7jgZnjgIINCi8vXy8g44CQIGh0dHA6Ly93d3cuaDMuZGlvbi5uZS5qcC9+c2FrYXRzdS9ob2xpZGF5X2xvZ2ljLmh0bSDj"
  code = code & "gJENCi8vXy8g44G444Gu44Oq44Oz44Kv44Gr44KI44KL57S55LuL44Gn5a++5b+c44GX44Gm5LiL44GV44GE44CCDQovL18vICgq"
  code = code & "Mylba3RIb2xpZGF5TmFtZV3jgajjgYTjgYbplqLmlbDlkI3jgZ3jga7jgoLjga7jga/jgIHlkIToh6rjga7nkrDlooPjgasNCi8v"
  code = code & "Xy8g44GK44GR44KL5ZG95ZCN6KaP5YmH44Gr5rK/44Gj44Gm5aSJ5pu044GX44Gm44KC5qeL44GE44G+44Gb44KT44CCDQovL18v"
  code = code & "IA0KLy9fL18vXy9fL18vXy9fL18vXy9fL18vXy9fL18vXy9fL18vXy9fL18vXy9fL18vXy9fL18vXy9fL18vXy9fL18vDQovLw0K"
  code = code & "Ly8gMjAwOC8xMC8yOSDlpInmlbDjga52YXLmjIflrprjgYznhKHjgY/jgIHluoPln5/lpInmlbDmibHjgYTjgavjgarjgaPjgabj"
  code = code & "gYTjgZ/jga7jgpLkv67mraPjgZfjgb7jgZfjgZ/jgIINCi8vDQovLyAyMDExLzMvMjAgIEZpcmVGb3gzLjUvMy4244Gn5L2/55So"
  code = code & "44GX44Gf5aC05ZCI44Gr6ZaT6YGV44Gj44Gf57WQ5p6c44KS6L+U44GZ5aC05ZCI44GM44GC44KK44G+44GX44Gf44CCDQovLyAg"
  code = code & "ICAgICAgICAgIEZpcmVGb3jjga5KSVTjgrPjg7Pjg5HjgqTjg6koVHJhY2VNb25rZXkp44Gu5LiN5YW35ZCI44Gr44KI44KLc3dp"
  code = code & "dGNo44K544OG44O844OI44OhDQovLyAgICAgICAgICAgIOODs+ODiOOBruiqpOOCs+ODs+ODkeOCpOODq+OBjOWOn+WboOOBp+OB"
  code = code & "guOCi+OBqOWIpOaYjuOBl+OBn+OBn+OCgeOAgXN3aXRjaOOCkltpZiBlbHNlXeOBqw0KLy8gICAgICAgICAgICDlpInmm7TjgZfj"
  code = code & "gb7jgZfjgZ/jgILjgarjgYrjgIHmnKzjgrnjgq/jg6rjg5fjg4jjga7jg5DjgrDjgafjga/jgYLjgorjgb7jgZvjgpPjga7jgafj"
  code = code & "gIFGaXJlRm94DQovLyAgICAgICAgICAgIOS7peWkluOBruODluODqeOCpuOCtuOBp+OBr+WVj+mhjOOBr+i1t+OBjeOBpuOBhOOB"
  code = code & "vuOBm+OCk++8iOS/ruato+WJjeOBrnN3aXRjaOOCkuS9v+OBo+OBn+OCueOCrw0KLy8gICAgICAgICAgICDjg6rjg5fjg4jjgafj"
  code = code & "goJGaXJlRm945Lul5aSW44Gu44OW44Op44Km44K244Gn44Gv5q2j5bi444Gr5YuV5L2c44GX44G+44GZ77yJ44CCDQovLyAgICAg"
  code = code & "ICAgICAgIOOBk+OBrkZpcmVGb3jjga7jg5DjgrDjgavplqLjgZnjgovop6PoqqzjgpLkuIvoqJjjgavmlbTnkIbjgZfjgabjgYLj"
  code = code & "gorjgb7jgZnjgIINCi8vICAgICAgICAgICAgICBodHRwOi8vd3d3LmgzLmRpb24ubmUuanAvfnNha2F0c3UvRmlyZUZveF9UTUJ1"
  code = code & "Z1Rlc3QuaHRtDQovLyAgICAgICAgICAgIOS/ruato+WJjeOBrnN3aXRjaOOCkuS9v+OBo+OBn+ODkOODvOOCuOODp+ODs+OBr+S4"
  code = code & "i+iomOOBq+aui+OBl+OBpuOBguOCiuOBvuOBmeOAgg0KLy8gICAgICAgICAgICAgIGh0dHA6Ly93d3cuaDMuZGlvbi5uZS5qcC9+"
  code = code & "c2FrYXRzdS9Ib2xpZGF5Q2hrX3N3aXRjaC5qcw0KDQp2YXIgTU9OREFZID0gMTsNCnZhciBUVUVTREFZID0gMjsNCnZhciBXRURO"
  code = code & "RVNEQVkgPSAzOw0KDQovLyBKYXZhU2NyaXB044Gn5omx44GI44KL5pel5LuY44GvMTk3MC8xLzHvvZ7jga7jgb8NCi8vdmFyIGNz"
  code = code & "dEltcGxlbWVudFRoZUxhd09mSG9saWRheSA9IG5ldyBEYXRlKCIxOTQ4LzcvMjAiKTsgIC8vIOelneaXpeazleaWveihjA0KLy92"
  code = code & "YXIgY3N0QWtpaGl0b0tla2tvbiA9IG5ldyBEYXRlKCIxOTU5LzQvMTAiKTsgICAgICAgICAgICAgIC8vIOaYjuS7geimqueOi+OB"
  code = code & "rue1kOWpmuOBruWEgA0KdmFyIGNzdFNob3dhVGFpc28gPSBuZXcgRGF0ZSgiMTk4OS8yLzI0Iik7ICAgICAgICAgICAgICAgIC8v"
  code = code & "IOaYreWSjOWkqeeah+Wkp+WWquOBruekvA0KdmFyIGNzdE5vcmloaXRvS2Vra29uID0gbmV3IERhdGUoIjE5OTMvNi85Iik7ICAg"
  code = code & "ICAgICAgICAgLy8g5b6z5LuB6Kaq546L44Gu57WQ5ama44Gu5YSADQp2YXIgY3N0U29rdWlyZWlzZWlkZW4gPSBuZXcgRGF0ZSgi"
  code = code & "MTk5MC8xMS8xMiIpOyAgICAgICAgICAvLyDljbPkvY3npLzmraPmrr/jga7lhIANCnZhciBjc3RJbXBsZW1lbnRIb2xpZGF5ID0g"
  code = code & "bmV3IERhdGUoIjE5NzMvNC8xMiIpOyAgICAgICAgLy8g5oyv5pu/5LyR5pel5pa96KGMDQoNCi8vIFtwcm1EYXRlXeOBq+OBryAi"
  code = code & "eXl5eS9tL2Qi5b2i5byP44Gu5pel5LuY5paH5a2X5YiX44KS5rih44GZDQpmdW5jdGlvbiBrdEhvbGlkYXlOYW1lKHBybURhdGUp"
  code = code & "DQp7DQogIHZhciBNeURhdGUgPSBuZXcgRGF0ZShwcm1EYXRlKTsNCiAgdmFyIEhvbGlkYXlOYW1lID0gcHJ2SG9saWRheUNoayhN"
  code = code & "eURhdGUpOw0KICB2YXIgWWVzdGVyRGF5Ow0KICB2YXIgSG9saWRheU5hbWVfcmV0Ow0KDQogIGlmIChIb2xpZGF5TmFtZSA9PSAi"
  code = code & "Iikgew0KICAgICAgaWYgKE15RGF0ZS5nZXREYXkoKSA9PSBNT05EQVkpIHsNCiAgICAgICAgICAvLyDmnIjmm5zku6XlpJbjga/m"
  code = code & "jK/mm7/kvJHml6XliKTlrprkuI3opoENCiAgICAgICAgICAvLyA1LzYo54GrLOawtCnjga7liKTlrprjga9wcnZIb2xpZGF5Q2hr"
  code = code & "44Gn5Yem55CG5riIDQogICAgICAgICAgLy8gNS82KOaciCnjga/jgZPjgZPjgafliKTlrprjgZnjgosNCiAgICAgICAgICBpZiAo"
  code = code & "TXlEYXRlLmdldFRpbWUoKSA+PSBjc3RJbXBsZW1lbnRIb2xpZGF5LmdldFRpbWUoKSkgew0KICAgICAgICAgICAgICBZZXN0ZXJE"
  code = code & "YXkgPSBuZXcgRGF0ZShNeURhdGUuZ2V0RnVsbFllYXIoKSwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBN"
  code = code & "eURhdGUuZ2V0TW9udGgoKSwoTXlEYXRlLmdldERhdGUoKS0xKSk7DQogICAgICAgICAgICAgIEhvbGlkYXlOYW1lID0gcHJ2SG9s"
  code = code & "aWRheUNoayhZZXN0ZXJEYXkpOw0KICAgICAgICAgICAgICBpZiAoSG9saWRheU5hbWUgIT0gIiIpIHsNCiAgICAgICAgICAgICAg"
  code = code & "ICAgIEhvbGlkYXlOYW1lX3JldCA9ICLmjK/mm7/kvJHml6UiOw0KICAgICAgICAgICAgICB9IGVsc2Ugew0KICAgICAgICAgICAg"
  code = code & "ICAgICAgSG9saWRheU5hbWVfcmV0ID0gIiI7DQogICAgICAgICAgICAgIH0NCiAgICAgICAgICB9IGVsc2Ugew0KICAgICAgICAg"
  code = code & "ICAgICBIb2xpZGF5TmFtZV9yZXQgPSAiIjsNCiAgICAgICAgICB9DQogICAgICB9IGVsc2Ugew0KICAgICAgICAgIEhvbGlkYXlO"
  code = code & "YW1lX3JldCA9ICIiOw0KICAgICAgfQ0KICB9IGVsc2Ugew0KICAgICAgSG9saWRheU5hbWVfcmV0ID0gSG9saWRheU5hbWU7DQog"
  code = code & "IH0NCg0KICByZXR1cm4gSG9saWRheU5hbWVfcmV0Ow0KfQ0KDQovLz09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09"
  code = code & "PT09PT09PT09PT09PT09PT09PT09PT09PT09PQ0KDQpmdW5jdGlvbiBwcnZIb2xpZGF5Q2hrKE15RGF0ZSkNCnsNCiAgdmFyIE15"
  code = code & "WWVhciA9IE15RGF0ZS5nZXRGdWxsWWVhcigpOw0KICB2YXIgTXlNb250aCA9IE15RGF0ZS5nZXRNb250aCgpICsgMTsgICAgLy8g"
  code = code & "TXlNb250aDox772eMTINCiAgdmFyIE15RGF5ID0gTXlEYXRlLmdldERhdGUoKTsNCiAgdmFyIE51bWJlck9mV2VlazsNCiAgdmFy"
  code = code & "IE15QXV0dW1uRXF1aW5veDsNCg0KLy8gSmF2YVNjcmlwdOOBp+aJseOBiOOCi+aXpeS7mOOBrzE5NzAvMS8x772e44Gu44G/44Gn"
  code = code & "56Wd5pel5rOV5pa96KGM5b6M44Gq44Gu44Gn5LiL6KiY44Gv5LiN6KaBDQovLyBpZiAoTXlEYXRlLmdldFRpbWUoKSA8IGNzdElt"
  code = code & "cGxlbWVudFRoZUxhd09mSG9saWRheS5nZXRUaW1lKCkpIHsNCi8vIOOAgOOAgHJldHVybiAiIjsgLy8g56Wd5pel5rOV5pa96KGM"
  code = code & "KDE5NDgvNy8yMCnku6XliY0NCi8vIH0gZWxzZTsNCg0KICB2YXIgUmVzdWx0ID0gIiI7DQoNCi8vIO+8keaciCAvLw0KICBpZiAo"
  code = code & "TXlNb250aCA9PSAxKSB7DQogICAgICBpZiAoTXlEYXkgPT0gMSkgew0KICAgICAgICAgIFJlc3VsdCA9ICLlhYPml6UiOw0KICAg"
  code = code & "ICAgfSBlbHNlIHsNCiAgICAgICAgICBpZiAoTXlZZWFyID49IDIwMDApIHsNCiAgICAgICAgICAgICAgTnVtYmVyT2ZXZWVrID0g"
  code = code & "TWF0aC5mbG9vcigoTXlEYXkgLSAxKSAvIDcpICsgMTsNCiAgICAgICAgICAgICAgaWYgKChOdW1iZXJPZldlZWsgPT0gMikgJiYg"
  code = code & "KE15RGF0ZS5nZXREYXkoKSA9PSBNT05EQVkpKSB7DQogICAgICAgICAgICAgICAgICBSZXN1bHQgPSAi5oiQ5Lq644Gu5pelIjsN"
  code = code & "CiAgICAgICAgICAgICAgfSBlbHNlOw0KICAgICAgICAgIH0gZWxzZSB7DQogICAgICAgICAgICAgIGlmIChNeURheSA9PSAxNSkg"
  code = code & "ew0KICAgICAgICAgICAgICAgICAgUmVzdWx0ID0gIuaIkOS6uuOBruaXpSI7DQogICAgICAgICAgICAgIH0gZWxzZTsNCiAgICAg"
  code = code & "ICAgICB9DQogICAgICB9DQogICAgICByZXR1cm4gUmVzdWx0Ow0KICB9IGVsc2U7DQoNCi8vIO+8kuaciCAvLw0KICBpZiAoTXlN"
  code = code & "b250aCA9PSAyKSB7DQogICAgICBpZiAoTXlEYXkgPT0gMTEpIHsNCiAgICAgICAgICBpZiAoTXlZZWFyID49IDE5NjcpIHsNCiAg"
  code = code & "ICAgICAgICAgICAgUmVzdWx0ID0gIuW7uuWbveiomOW/teOBruaXpSI7DQogICAgICAgICAgfSBlbHNlOw0KICAgICAgfSBlbHNl"
  code = code & "IHsNCiAgICAgICAgICBpZiAoTXlEYXRlLmdldFRpbWUoKSA9PSBjc3RTaG93YVRhaXNvLmdldFRpbWUoKSkgew0KICAgICAgICAg"
  code = code & "ICAgICBSZXN1bHQgPSAi5pit5ZKM5aSp55qH44Gu5aSn5Zaq44Gu56S8IjsNCiAgICAgICAgICB9IGVsc2U7DQogICAgICB9DQog"
  code = code & "ICAgICByZXR1cm4gUmVzdWx0Ow0KICB9IGVsc2U7DQoNCi8vIO+8k+aciCAvLw0KICBpZiAoTXlNb250aCA9PSAzKSB7DQogICAg"
  code = code & "ICBpZiAoTXlEYXkgPT0gcHJ2RGF5T2ZTcHJpbmdFcXVpbm94KE15WWVhcikpIHsgIC8vIDE5NDjvvZ4yMTUw5Lul5aSW44GvWzk5"
  code = code & "XQ0KICAgICAgICAgIFJlc3VsdCA9ICLmmKXliIbjga7ml6UiOyAgICAgICAgICAgICAgICAgICAgICAgLy8g44GM6L+U44KL44Gu"
  code = code & "44Gn772k5b+F44Ga4omg44Gr44Gq44KLDQogICAgICB9IGVsc2U7DQogICAgICByZXR1cm4gUmVzdWx0Ow0KICB9IGVsc2U7DQoN"
  code = code & "Ci8vIO+8lOaciCAvLw0KICBpZiAoTXlNb250aCA9PSA0KSB7DQogICAgICBpZiAoTXlEYXkgPT0gMjkpIHsNCiAgICAgICAgICBp"
  code = code & "ZiAoTXlZZWFyID49IDIwMDcpIHsNCiAgICAgICAgICAgICAgUmVzdWx0ID0gIuaYreWSjOOBruaXpSI7DQogICAgICAgICAgfSBl"
  code = code & "bHNlIHsNCiAgICAgICAgICAgICAgaWYgKE15WWVhciA+PSAxOTg5KSB7DQogICAgICAgICAgICAgICAgICBSZXN1bHQgPSAi44G/"
  code = code & "44Gp44KK44Gu5pelIjsNCiAgICAgICAgICAgICAgfSBlbHNlIHsNCiAgICAgICAgICAgICAgICBSZXN1bHQgPSAi5aSp55qH6KqV"
  code = code & "55Sf5pelIjsNCiAgICAgICAgICAgICAgfQ0KICAgICAgICAgIH0NCiAgICAgIH0gZWxzZSB7DQogICAgICAgICAgLy8gSmF2YVNj"
  code = code & "cmlwdOOBp+aJseOBiOOCi+aXpeS7mOOBrzE5NzAvMS8x772e44Gu44G/44Gq44Gu44Gn5LiL6KiY44Gv5LiN6KaBDQogICAgICAg"
  code = code & "ICAgLy8gaWYgKE15RGF0ZS5nZXRUaW1lKCkgPT0gY3N0QWtpaGl0b0tla2tvbi5nZXRUaW1lKCkpIHsNCiAgICAgICAgICAvLyDj"
  code = code & "gIDjgIBSZXN1bHQgPSAi55qH5aSq5a2Q5piO5LuB6Kaq546L44Gu57WQ5ama44Gu5YSAIjvjgIDjgIAvLyAoPTE5NTkvNC8xMCkN"
  code = code & "CiAgICAgICAgICAvLyB9IGVsc2U7DQogICAgICB9DQogICAgICByZXR1cm4gUmVzdWx0Ow0KICB9IGVsc2U7DQoNCi8vIO+8leac"
  code = code & "iCAvLw0KICBpZiAoTXlNb250aCA9PSA1KSB7DQogICAgICBpZiAoTXlEYXkgPT0gMykgeyAgLy8g77yV5pyI77yT5pelDQogICAg"
  code = code & "ICAgICAgUmVzdWx0ID0gIuaGsuazleiomOW/teaXpSI7DQogICAgICB9IGVsc2U7DQoNCiAgICAgIGlmIChNeURheSA9PSA0KSB7"
  code = code & "ICAvLyDvvJXmnIjvvJTml6UNCiAgICAgICAgICBpZiAoTXlZZWFyID49IDIwMDcpIHsNCiAgICAgICAgICAgICAgUmVzdWx0ID0g"
  code = code & "IuOBv+OBqeOCiuOBruaXpSI7DQogICAgICAgICAgfSBlbHNlIHsNCiAgICAgICAgICAgICAgaWYgKE15WWVhciA+PSAxOTg2KSB7"
  code = code & "DQogICAgICAgICAgICAgICAgICBpZiAoTXlEYXRlLmdldERheSgpID4gTU9OREFZKSB7DQogICAgICAgICAgICAgICAgICAvLyA1"
  code = code & "LzTjgYzml6Xmm5zml6Xjga/jgI7lj6rjga7ml6Xmm5zjgI/vvaTmnIjmm5zml6Xjga/jgI7mhrLms5XoqJjlv7Xml6Xjga7mjK/m"
  code = code & "m7/kvJHml6XjgI8o772eMjAwNuW5tCkNCiAgICAgICAgICAgICAgICAgICAgICBSZXN1bHQgPSAi5Zu95rCR44Gu5LyR5pelIjsN"
  code = code & "CiAgICAgICAgICAgICAgICAgIH0gZWxzZTsNCiAgICAgICAgICAgICAgfSBlbHNlOw0KICAgICAgICAgIH0NCiAgICAgIH0gZWxz"
  code = code & "ZTsNCg0KICAgICAgaWYgKE15RGF5ID09IDUpIHsgIC8vIO+8leaciO+8leaXpQ0KICAgICAgICAgIFJlc3VsdCA9ICLjgZPjganj"
  code = code & "goLjga7ml6UiOw0KICAgICAgfSBlbHNlOw0KDQogICAgICBpZiAoTXlEYXkgPT0gNikgeyAgLy8g77yV5pyI77yW5pelDQogICAg"
  code = code & "ICAgICAgaWYgKE15WWVhciA+PSAyMDA3KSB7DQogICAgICAgICAgICAgIGlmICgoTXlEYXRlLmdldERheSgpID09IFRVRVNEQVkp"
  code = code & "IHx8IChNeURhdGUuZ2V0RGF5KCkgPT0gV0VETkVTREFZKSkgew0KICAgICAgICAgICAgICAgICAgUmVzdWx0ID0gIuaMr+abv+S8"
  code = code & "keaXpSI7ICAgIC8vIFs1LzMsNS8044GM5pel5pucXeOCseODvOOCueOBruOBv+OAgeOBk+OBk+OBp+WIpOWumg0KICAgICAgICAg"
  code = code & "ICAgICB9IGVsc2U7DQogICAgICAgICAgfSBlbHNlOw0KICAgICAgfSBlbHNlOw0KDQogICAgICByZXR1cm4gUmVzdWx0Ow0KICB9"
  code = code & "IGVsc2U7DQoNCi8vIO+8luaciCAvLw0KICBpZiAoTXlNb250aCA9PSA2KSB7DQogICAgICBpZiAoTXlEYXRlLmdldFRpbWUoKSA9"
  code = code & "PSBjc3ROb3JpaGl0b0tla2tvbi5nZXRUaW1lKCkpIHsNCiAgICAgICAgICBSZXN1bHQgPSAi55qH5aSq5a2Q5b6z5LuB6Kaq546L"
  code = code & "44Gu57WQ5ama44Gu5YSAIjsNCiAgICAgIH0gZWxzZTsNCiAgICAgIHJldHVybiBSZXN1bHQ7DQogIH0gZWxzZTsNCg0KLy8g77yX"
  code = code & "5pyIIC8vDQogIGlmIChNeU1vbnRoID09IDcpIHsNCiAgICAgIGlmIChNeVllYXIgPj0gMjAwMykgew0KICAgICAgICAgIE51bWJl"
  code = code & "ck9mV2VlayA9IE1hdGguZmxvb3IoKE15RGF5IC0gMSkgLyA3KSArIDE7DQogICAgICAgICAgaWYgKChOdW1iZXJPZldlZWsgPT0g"
  code = code & "MykgJiYgKE15RGF0ZS5nZXREYXkoKSA9PSBNT05EQVkpKSB7DQogICAgICAgICAgICAgIFJlc3VsdCA9ICLmtbfjga7ml6UiOw0K"
  code = code & "ICAgICAgICAgIH0gZWxzZTsNCiAgICAgIH0gZWxzZSB7DQogICAgICAgICAgaWYgKE15WWVhciA+PSAxOTk2KSB7DQogICAgICAg"
  code = code & "ICAgICAgIGlmIChNeURheSA9PSAyMCkgew0KICAgICAgICAgICAgICAgICAgUmVzdWx0ID0gIua1t+OBruaXpSI7DQogICAgICAg"
  code = code & "ICAgICAgIH0gZWxzZTsNCiAgICAgICAgICB9IGVsc2U7DQogICAgICB9DQogICAgICByZXR1cm4gUmVzdWx0Ow0KICB9IGVsc2U7"
  code = code & "DQoNCi8vIO+8mOaciCAvLyANCiAgaWYgKE15TW9udGggPT0gOCkgew0KICAgICAgcmV0dXJuICIiOyAgICAvLyAo56Wd5pel44Gv"
  code = code & "54Sh44GE77yJDQogIH0gZWxzZTsNCg0KICANCi8vIO+8meaciCAvLw0KICBpZiAoTXlNb250aCA9PSA5KSB7DQogICAgICAvL+es"
  code = code & "rO+8k+aciOabnOaXpSgxNe+9njIxKeOBqOeni+WIhuaXpSgyMu+9njI0KeOBjOmHjeOBquOCi+S6i+OBr+OBquOBhA0KICAgICAg"
  code = code & "TXlBdXR1bW5FcXVpbm94ID0gcHJ2RGF5T2ZBdXR1bW5FcXVpbm94KE15WWVhcik7DQogICAgICBpZiAoTXlEYXkgPT0gTXlBdXR1"
  code = code & "bW5FcXVpbm94KSB7ICAgIC8vIDE5NDjvvZ4yMTUw5Lul5aSW44GvWzk5XQ0KICAgICAgICAgIFJlc3VsdCA9ICLnp4vliIbjga7m"
  code = code & "l6UiOyAgICAgICAgICAgLy8g44GM6L+U44KL44Gu44Gn772k5b+F44Ga4omg44Gr44Gq44KLDQogICAgICB9IGVsc2Ugew0KICAg"
  code = code & "ICAgICAgIGlmIChNeVllYXIgPj0gMjAwMykgew0KICAgICAgICAgICAgICBOdW1iZXJPZldlZWsgPSBNYXRoLmZsb29yKChNeURh"
  code = code & "eSAtIDEpIC8gNykgKyAxOw0KICAgICAgICAgICAgICBpZiAoKE51bWJlck9mV2VlayA9PSAzKSAmJiAoTXlEYXRlLmdldERheSgp"
  code = code & "ID09IE1PTkRBWSkpIHsNCiAgICAgICAgICAgICAgICAgIFJlc3VsdCA9ICLmlazogIHjga7ml6UiOw0KICAgICAgICAgICAgICB9"
  code = code & "IGVsc2Ugew0KICAgICAgICAgICAgICAgICAgaWYgKE15RGF0ZS5nZXREYXkoKSA9PSBUVUVTREFZKSB7DQogICAgICAgICAgICAg"
  code = code & "ICAgICAgICAgaWYgKE15RGF5ID09IChNeUF1dHVtbkVxdWlub3ggLSAxKSkgew0KICAgICAgICAgICAgICAgICAgICAgICAgICBS"
  code = code & "ZXN1bHQgPSAi5Zu95rCR44Gu5LyR5pelIjsNCiAgICAgICAgICAgICAgICAgICAgICB9IGVsc2U7DQogICAgICAgICAgICAgICAg"
  code = code & "ICB9IGVsc2U7DQogICAgICAgICAgICAgIH0NCiAgICAgICAgICB9IGVsc2Ugew0KICAgICAgICAgICAgICBpZiAoTXlZZWFyID49"
  code = code & "IDE5NjYpIHsNCiAgICAgICAgICAgICAgICAgIGlmIChNeURheSA9PSAxNSkgew0KICAgICAgICAgICAgICAgICAgICAgIFJlc3Vs"
  code = code & "dCA9ICLmlazogIHjga7ml6UiOw0KICAgICAgICAgICAgICAgICAgfSBlbHNlOw0KICAgICAgICAgICAgICB9IGVsc2U7DQogICAg"
  code = code & "ICAgICAgfQ0KICAgICAgfQ0KICAgICAgcmV0dXJuIFJlc3VsdDsNCiAgfSBlbHNlOw0KDQovLyDvvJHvvJDmnIggLy8NCiAgaWYg"
  code = code & "KE15TW9udGggPT0gMTApIHsNCiAgICAgIGlmIChNeVllYXIgPj0gMjAwMCkgew0KICAgICAgICAgIE51bWJlck9mV2VlayA9IE1h"
  code = code & "dGguZmxvb3IoKCBNeURheSAtIDEpIC8gNykgKyAxOw0KICAgICAgICAgIGlmICgoTnVtYmVyT2ZXZWVrID09IDIpICYmIChNeURh"
  code = code & "dGUuZ2V0RGF5KCkgPT0gTU9OREFZKSkgew0KICAgICAgICAgICAgICBSZXN1bHQgPSAi5L2T6IKy44Gu5pelIjsNCiAgICAgICAg"
  code = code & "ICB9IGVsc2U7DQogICAgICB9IGVsc2Ugew0KICAgICAgICAgIGlmIChNeVllYXIgPj0gMTk2Nikgew0KICAgICAgICAgICAgICBp"
  code = code & "ZiAoTXlEYXkgPT0gMTApIHsNCiAgICAgICAgICAgICAgICAgIFJlc3VsdCA9ICLkvZPogrLjga7ml6UiOw0KICAgICAgICAgICAg"
  code = code & "ICB9IGVsc2U7DQogICAgICAgICAgfSBlbHNlOw0KICAgICAgfQ0KICAgICAgcmV0dXJuIFJlc3VsdDsNCiAgfSBlbHNlOw0KDQov"
  code = code & "LyDvvJHvvJHmnIggLy8NCiAgaWYgKE15TW9udGggPT0gMTEpIHsNCiAgICAgIGlmIChNeURheSA9PSAzKSB7DQogICAgICAgICAg"
  code = code & "UmVzdWx0ID0gIuaWh+WMluOBruaXpSI7DQogICAgICB9IGVsc2Ugew0KICAgICAgICAgIGlmIChNeURheSA9PSAyMykgew0KICAg"
  code = code & "ICAgICAgICAgICBSZXN1bHQgPSAi5Yuk5Yq05oSf6Kyd44Gu5pelIjsNCiAgICAgICAgICB9IGVsc2Ugew0KICAgICAgICAgICAg"
  code = code & "ICBpZiAoTXlEYXRlLmdldFRpbWUoKSA9PSBjc3RTb2t1aXJlaXNlaWRlbi5nZXRUaW1lKCkpIHsNCiAgICAgICAgICAgICAgICAg"
  code = code & "IFJlc3VsdCA9ICLljbPkvY3npLzmraPmrr/jga7lhIAiOw0KICAgICAgICAgICAgICB9IGVsc2U7DQogICAgICAgICAgfQ0KICAg"
  code = code & "ICAgfQ0KICAgICAgcmV0dXJuIFJlc3VsdDsNCiAgfSBlbHNlOw0KDQovLyDvvJHvvJLmnIggLy8NCiAgaWYgKE15TW9udGggPT0g"
  code = code & "MTIpIHsNCiAgICAgIGlmIChNeURheSA9PSAyMykgew0KICAgICAgICAgIGlmIChNeVllYXIgPj0gMTk4OSkgew0KICAgICAgICAg"
  code = code & "ICAgICBSZXN1bHQgPSAi5aSp55qH6KqV55Sf5pelIjsNCiAgICAgICAgICB9IGVsc2U7DQogICAgICB9IGVsc2U7DQogICAgICBy"
  code = code & "ZXR1cm4gUmVzdWx0Ow0KICB9IGVsc2U7DQoNCn0NCg0KLy89PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09"
  code = code & "PT09PT09PT09PT09PT09PT09PT09PT09PT09DQovLyDmmKXliIYv56eL5YiG5pel44Gu55Wl566X5byP44GvDQovLyDjgI7mtbfk"
  code = code & "uIrkv53lronluoHmsLTot6/pg6gg5pqm6KiI566X56CU56m25Lya57eoIOaWsOOBk+OCiOOBv+S+v+WIqeW4s+OAjw0KLy8g44Gn"
  code = code & "57S55LuL44GV44KM44Gm44GE44KL5byP44Gn44GZ44CCDQpmdW5jdGlvbiBwcnZEYXlPZlNwcmluZ0VxdWlub3goTXlZZWFyKQ0K"
  code = code & "ew0KICB2YXIgU3ByaW5nRXF1aW5veF9yZXQ7DQoNCiAgaWYgKE15WWVhciA8PSAxOTQ3KSB7DQogICAgICBTcHJpbmdFcXVpbm94"
  code = code & "X3JldCA9IDk5OyAgICAvL+elneaXpeazleaWveihjOWJjQ0KICB9IGVsc2Ugew0KICAgICAgaWYgKE15WWVhciA8PSAxOTc5KSB7"
  code = code & "DQogICAgICAgICAgLy8gTWF0aC5mbG9vciDplqLmlbDjga9bVkJB44GuSW506Zai5pWwXeOBq+ebuOW9kw0KICAgICAgICAgIFNw"
  code = code & "cmluZ0VxdWlub3hfcmV0ID0gTWF0aC5mbG9vcigyMC44MzU3ICsgDQogICAgICAgICAgICAoMC4yNDIxOTQgKiAoTXlZZWFyIC0g"
  code = code & "MTk4MCkpIC0gTWF0aC5mbG9vcigoTXlZZWFyIC0gMTk4MCkgLyA0KSk7DQogICAgICB9IGVsc2Ugew0KICAgICAgICAgIGlmIChN"
  code = code & "eVllYXIgPD0gMjA5OSkgew0KICAgICAgICAgICAgICBTcHJpbmdFcXVpbm94X3JldCA9IE1hdGguZmxvb3IoMjAuODQzMSArIA0K"
  code = code & "ICAgICAgICAgICAgICAgICgwLjI0MjE5NCAqIChNeVllYXIgLSAxOTgwKSkgLSBNYXRoLmZsb29yKChNeVllYXIgLSAxOTgwKSAv"
  code = code & "IDQpKTsNCiAgICAgICAgICB9IGVsc2Ugew0KICAgICAgICAgICAgICBpZiAoTXlZZWFyIDw9IDIxNTApIHsNCiAgICAgICAgICAg"
  code = code & "ICAgICAgIFNwcmluZ0VxdWlub3hfcmV0ID0gTWF0aC5mbG9vcigyMS44NTEgKyANCiAgICAgICAgICAgICAgICAgICAgKDAuMjQy"
  code = code & "MTk0ICogKE15WWVhciAtIDE5ODApKSAtIE1hdGguZmxvb3IoKE15WWVhciAtIDE5ODApIC8gNCkpOw0KICAgICAgICAgICAgICB9"
  code = code & "IGVsc2Ugew0KICAgICAgICAgICAgICAgICAgU3ByaW5nRXF1aW5veF9yZXQgPSA5OTsgICAgLy8yMTUx5bm05Lul6ZmN44Gv55Wl"
  code = code & "566X5byP44GM54Sh44GE44Gu44Gn5LiN5piODQogICAgICAgICAgICAgIH0NCiAgICAgICAgICB9DQogICAgICB9DQogIH0NCiAg"
  code = code & "cmV0dXJuIFNwcmluZ0VxdWlub3hfcmV0Ow0KfQ0KDQovLz09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09PT09"
  code = code & "PT09PT09PT09PT09PT09PT09PT09PT09PT09PQ0KZnVuY3Rpb24gcHJ2RGF5T2ZBdXR1bW5FcXVpbm94KE15WWVhcikNCnsNCiAg"
  code = code & "dmFyIEF1dHVtbkVxdWlub3hfcmV0Ow0KDQogIGlmIChNeVllYXIgPD0gMTk0Nykgew0KICAgICAgQXV0dW1uRXF1aW5veF9yZXQg"
  code = code & "PSA5OTsgLy/npZ3ml6Xms5Xmlr3ooYzliY0NCiAgfSBlbHNlIHsNCiAgICAgIGlmIChNeVllYXIgPD0gMTk3OSkgew0KICAgICAg"
  code = code & "ICAgIC8vIE1hdGguZmxvb3Ig6Zai5pWw44GvW1ZCQeOBrkludOmWouaVsF3jgavnm7jlvZMNCiAgICAgICAgICBBdXR1bW5FcXVp"
  code = code & "bm94X3JldCA9IE1hdGguZmxvb3IoMjMuMjU4OCArIA0KICAgICAgICAgICAgKDAuMjQyMTk0ICogKE15WWVhciAtIDE5ODApKSAt"
  code = code & "IE1hdGguZmxvb3IoKE15WWVhciAtIDE5ODApIC8gNCkpOw0KICAgICAgfSBlbHNlIHsNCiAgICAgICAgICBpZiAoTXlZZWFyIDw9"
  code = code & "IDIwOTkpIHsNCiAgICAgICAgICAgICAgQXV0dW1uRXF1aW5veF9yZXQgPSBNYXRoLmZsb29yKDIzLjI0ODggKyANCiAgICAgICAg"
  code = code & "ICAgICAgICAoMC4yNDIxOTQgKiAoTXlZZWFyIC0gMTk4MCkpIC0gTWF0aC5mbG9vcigoTXlZZWFyIC0gMTk4MCkgLyA0KSk7DQog"
  code = code & "ICAgICAgICAgfSBlbHNlIHsNCiAgICAgICAgICAgICAgaWYgKE15WWVhciA8PSAyMTUwKSB7DQogICAgICAgICAgICAgICAgICBB"
  code = code & "dXR1bW5FcXVpbm94X3JldCA9IE1hdGguZmxvb3IoMjQuMjQ4OCArIA0KICAgICAgICAgICAgICAgICAgICAoMC4yNDIxOTQgKiAo"
  code = code & "TXlZZWFyIC0gMTk4MCkpIC0gTWF0aC5mbG9vcigoTXlZZWFyIC0gMTk4MCkgLyA0KSk7DQogICAgICAgICAgICAgIH0gZWxzZSB7"
  code = code & "DQogICAgICAgICAgICAgICAgICBBdXR1bW5FcXVpbm94X3JldCA9IDk5OyAgICAvLzIxNTHlubTku6XpmY3jga/nlaXnrpflvI/j"
  code = code & "gYznhKHjgYTjga7jgafkuI3mmI4NCiAgICAgICAgICAgICAgfQ0KICAgICAgICAgIH0NCiAgICAgIH0NCiAgfQ0KICByZXR1cm4g"
  code = code & "QXV0dW1uRXF1aW5veF9yZXQ7DQp9DQoNCi8vXy9fL18vXy9fL18vXy9fL18vXy9fL18vXy9fL18vXy9fL18vXy9fL18vXy9fL18v"
  code = code & "Xy9fL18vXy9fL18vXy9fLw0KLy9fLyBDb3B5UmlnaHQoQykgSy5Uc3Vub2RhKEFkZGluQm94KSAyMDAxIEFsbCBSaWdodHMgUmVz"
  code = code & "ZXJ2ZWQuDQovL18vXy9fL18vXy9fL18vXy9fL18vXy9fL18vXy9fL18vXy9fL18vXy9fL18vXy9fL18vXy9fL18vXy9fL18vXy8N"
  code = code & "Cg0KDQovLy0tPg=="
  
  GetHolidayChkScript = DecodeBase64Str(code)
End Function

Private Function DecodeBase64Str(ByVal code As String) As String
'Base64デコード(文字列)
  Dim d() As Byte
  Dim ret As String
  Const adTypeBinary = 1
  Const adTypeText = 2
  
  ret = "" '初期化
  On Error Resume Next
  With CreateObject("MSXML2.DOMDocument").createElement("base64")
    .DataType = "bin.base64"
    .Text = code
    d = .nodeTypedValue
  End With
  With CreateObject("ADODB.Stream")
    .Open
    .Charset = "UTF-8"
    .Type = adTypeBinary
    .write d
    .Position = 0
    .Type = adTypeText
    ret = .ReadText
    .Close
  End With
  On Error GoTo 0
  DecodeBase64Str = ret
End Function

「DisplayDatepicker」を実行すると、Internet Explorerが立ち上がりカレンダーが表示されます。

表示されたカレンダー上で日付を選択すると、イミディエイトウィンドウに選択した日付が表示されます。

仕組みとしては、jQueryや必要なスクリプト、スタイルを動的に設定し、非表示状態のテキストボックス経由で選択した日付を受け取る仕組みになっています。

今回は試験的にコードを書いてみただけなので冗長な処理になっていますが、実際に使用する場合は、クラス化して処理を簡単に呼び出せるようにした方が良いだろうと思います。

また、上記コードはInternet Explorerに依存する形になるため、必ずしも動作するとは限りません。とりあえずWindows 7 + Internet Explorer 9環境で動作確認を行いましたが、他の環境で動作させる場合は必要に応じて処理を変更してください。

【編集後記】

今回はかなり無理やりな処理を考えてみました。
祝日判定もExcel MVPの角田さん作の「日本の祝日判定ロジック」をBase64エンコードしてコード内に埋め込み、それをデコードしてドキュメントに書き込む、というような処理を行っています。

インターネット環境が必須な上に動作も軽いとは言えないので、需要がどこにあるのか非常に微妙なところですが、一応はVBAからjQuery UI・Datepickerが呼び出せるというサンプルです。

苦労したのはWebページ(JavaScript)からVBAへの値の受け渡しですが、非表示状態のHTMLInputTextElementのクリックイベントをtriggerするという、これもまた無理やりな処理を行うことで解決しました。

自分で書いておいてなんですが、使いどころは難しいなあと・・・。

投稿者: きぬあさ
Office関連, Excel, Word
コメント: 2

マイクロソフトコミュニティのスレッドURLを短くするブックマークレット前のページ

「カレンダーから日付入力」をUserFormに移植してみました。次のページ

Office関連

Data Explorerのフォーラム＆ブログ

前回の記事で紹介した「Data Explorer」ですが、すでにフォー…
アイコン一覧

Office 2013 アイコン一覧(Q)

・Office 2013 アイコン一覧 NUM…
Office関連

【2018年7月版】ソースコードを番号行付きのテーブルに変換するWordマクロ

6年以上前、Wordに貼り付けたソースコードを番号付きのテーブルに変換…
Office アドイン

[Office用アプリ]v1.1で追加されたgoToByIdAsyncメソッドを試してみました。

前回の記事の通り、Office 2013のService Pack 1…
Office関連

Microsoft Office 2013 Service Pack 1が公開されました。

「Microsoft、「Microsoft Office 2013 S…
Office関連

PowerShellからNetOfficeを使ってExcelを操作する方法

先日、Excel MVPの伊藤さんがPowerShellからExcel…

- えくせる
- 2014年 1月 30日 1:18pm
- 返信
- 引用
きぬあさ様

わがままなお願いを聞いて下さってありがとうございます。

しかし、VBA素人のわたしでは、excelに組み込むことができませんでした。

素人考えで申し訳ないのですが、ユーザーフォームを使って使用することは

可能でしょうか？

変な質問ばかりして申し訳ないなのですが、お返事お待ちしております。
- - きぬあさ
  - 2014年 1月 31日 4:02pm
  - 返信
  - 引用
  > えくせる様
  
  ユーザーフォームを使った処理も考えてみました。
  
  ・「カレンダーから日付入力」をUserFormに移植してみました。
  http://www.ka-net.org/blog/?p=3991
  
  ただ、記事中にも書いている通り環境依存で安定性に欠けたプログラムになっています。
  業務等で使う場合には、以前ご紹介した角田さんの「カレンダークラスモジュール」や「kt関数アドイン」等のVBA製のアドイン、マクロを使った方が良いだろうと思います。

この記事へのトラックバックはありません。

トラックバック URL

※本ページはプロモーションが含まれています。

Power Automate for desktopやMicrosoft Office開発の情報が満載

jQuery UIのDatepickerをVBAから使用するサンプル

【編集後記】

関連記事

Data Explorerのフォーラム＆ブログ

Office 2013 アイコン一覧(Q)

【2018年7月版】ソースコードを番号行付きのテーブルに変換するWordマクロ

[Office用アプリ]v1.1で追加されたgoToByIdAsyncメソッドを試してみました。

Microsoft Office 2013 Service Pack 1が公開されました。

PowerShellからNetOfficeを使ってExcelを操作する方法

コメント

Translate

最近の記事

アーカイブ

検索

カテゴリー

プロフィール

@kinuasa

おすすめ記事

メニュー