Office関連

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が立ち上がりカレンダーが表示されます。

VBA_Datepicker_01_01

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

VBA_Datepicker_01_02

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

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

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

【編集後記】

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

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

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

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

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

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

関連記事

  1. Office関連

    Office 2013で追加・変更されたコントロールID

    2013/03/25 追記:Office 2013のコントロールI…

  2. Office関連

    IEサポート終了でVBAマクロはどうなるの?(2)

    ※下記情報は2021年5月時点の情報で、今後状況が変わっていく可能性が…

  3. Office関連

    Office XP Developer Toolsでリボン対応のCOMアドインを作成する。

    「Visual Basic 6でリボン対応のアドインを作成する」ではV…

  4. Office関連

    ユーザー設定フォームに基づいてメールを作成するOutlookマクロ

    Outlookには「ユーザー設定フォーム」(Custom Forms)…

  5. Office アドイン

    「マイクロソフト Office 用アプリ開発スタートアップガイド」レビュー

    ※ 下記レビューはあくまでも個人的な感想です。日本初(恐らく)…

コメント

    • えくせる
    • 2014年 1月 30日 1:18pm

    きぬあさ様

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

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

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

    可能でしょうか?

    変な質問ばかりして申し訳ないなのですが、お返事お待ちしております。

    • > えくせる様

      ユーザーフォームを使った処理も考えてみました。

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

      ただ、記事中にも書いている通り環境依存で安定性に欠けたプログラムになっています。
      業務等で使う場合には、以前ご紹介した角田さんの「カレンダー クラスモジュール」や「kt関数アドイン」等のVBA製のアドイン、マクロを使った方が良いだろうと思います。

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

Time limit is exhausted. Please reload CAPTCHA.

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

Translate

最近の記事

アーカイブ

PAGE TOP