Office関連

[VBA]ユーザーフォームでBootstrapを使う。

MSDNフォーラムにあった質問「VBAでのフォーム オブジェクトを立体的なデザインから平面的なデザインにしたい」用に書いたコードです。

※ 64ビット版Officeで実行する場合は要修正

'UserForm1
'※ WebBrowserコントトール要配置
'※ Microsoft HTML Object Library(mshtml.tlb)要参照

Option Explicit

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As Office.IAccessible, ByRef phwnd As Long) As Long

Private WithEvents btn1 As MSHTML.HTMLButtonElement
Private WithEvents btn2 As MSHTML.HTMLButtonElement
Private WithEvents btn3 As MSHTML.HTMLButtonElement
Private WithEvents btn4 As MSHTML.HTMLButtonElement

Private Sub UserForm_Initialize()
  SetFormStyle
  RenderHtml
End Sub

Private Sub SetFormStyle()
'ユーザーフォームの外観設定
  Dim hForm As Long
  Dim style As Long
 
  WindowFromAccessibleObject Me, hForm
  If hForm <> 0 Then
    style = GetWindowLong(hForm, -16)
    style = style Or &H40000
    SetWindowLong hForm, -16, style
  End If
End Sub

Private Sub RenderHtml()
'WebBrowserにHTML描画
  Dim d As MSHTML.HTMLDocument
  Dim src As String
 
  With Me.WebBrowser1
    .Navigate "about:blank"
    While .Busy Or .ReadyState <> READYSTATE_COMPLETE
      DoEvents
    Wend
    Set d = .Document
  End With
 
  src = "<!DOCTYPE html>" & vbNewLine
  src = src & "<html lang=""ja"">" & vbNewLine
  src = src & "<head>" & vbNewLine
  src = src & "  <meta charset=""utf-8"">" & vbNewLine
  src = src & "  <meta http-equiv=""X-UA-Compatible"" content=""IE=edge"">" & vbNewLine
  src = src & "  <link rel=""stylesheet"" href=""https://maxcdn.bootstrapcdn.com/bootstrap/3.3.5/css/bootstrap.min.css"">" & vbNewLine
  src = src & "  <link rel=""stylesheet"" href=""https://maxcdn.bootstrapcdn.com/bootstrap/3.3.5/css/bootstrap-theme.min.css"">" & vbNewLine
  src = src & "  <script src=""https://code.jquery.com/jquery-1.11.3.min.js""></script>" & vbNewLine
  src = src & "  <script src=""https://maxcdn.bootstrapcdn.com/bootstrap/3.3.5/js/bootstrap.min.js""></script>" & vbNewLine
  src = src & "  <style>" & vbNewLine
  src = src & "    *{padding:5px;}" & vbNewLine
  src = src & "  </style>" & vbNewLine
  src = src & "</head>" & vbNewLine
  src = src & "<body>" & vbNewLine
  src = src & "  <div class=""container"">" & vbNewLine
 
  'ボタン追加
  src = src & "    <button id=""button1"" class=""btn btn-primary""><span class=""glyphicon glyphicon-globe""></span>button1</button>" & vbNewLine
  src = src & "    <button id=""button2"" class=""btn btn-success""><span class=""glyphicon glyphicon-cutlery""></span>button2</button>" & vbNewLine
  src = src & "    <button id=""button3"" class=""btn btn-info""><span class=""glyphicon glyphicon-folder-open""></span>button3</button>" & vbNewLine
  src = src & "    <button id=""button4"" class=""btn btn-danger""><span class=""glyphicon glyphicon-remove""></span>Close</button>" & vbNewLine
 
  src = src & "  </div>" & vbNewLine
  src = src & "</body>" & vbNewLine
  src = src & "</html>"
  VBA.CallByName d, "write", VbMethod, src
 
  Set btn1 = d.getElementById("button1")
  Set btn2 = d.getElementById("button2")
  Set btn3 = d.getElementById("button3")
  Set btn4 = d.getElementById("button4")
End Sub

Private Function btn1_onclick() As Boolean
  MsgBox btn1.ID, vbInformation
End Function

Private Function btn2_onclick() As Boolean
  MsgBox btn2.ID, vbExclamation
End Function

Private Function btn3_onclick() As Boolean
  MsgBox btn3.ID, vbCritical
End Function

Private Function btn4_onclick() As Boolean
  Unload Me
End Function

Private Sub UserForm_Resize()
'ユーザーフォームに合わせてWebBrowserリサイズ
  With Me.WebBrowser1
    .Width = Me.Width
    .Height = Me.Height
  End With
End Sub

VBA_Bootstrap_01

“平面的なデザイン”というのはよく分かりませんが、WebBrowser経由であれば「Bootstrap」等のフレームワークが利用できるので、既存のActiveXコントロールを使うよりも、デザイン性に優れたフォームに仕上げることができます。

余計なトラブルが発生する可能性もあるので、見た目にこだわりが無ければ既存のコントロールで十分だとは思いますが、「こういった方法も一応あるよ」ということで。

関連記事

  1. Office関連

    日本語の文法上の誤りを列挙して修正候補をコメントとして追加するWordマクロ

    前回の記事の関連で、今度は日本語の文法上の誤りを列挙して修正候補をコメ…

  2. Office関連

    PowerPoint 2013ではプレゼンテーションをmp4形式で保存できるようになりました。

    ※ この情報はOffice 2013 カスタマー プレビュー版を元にし…

  3. Office関連

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

    前回の記事では、Office 用アプリ「カレンダーから日付入力」と同様…

  4. Office関連

    Microsoft MVP for Outlook を初受賞しました。

    2010年7月から「Office System」分野でMicrosof…

  5. Office関連

    関数一覧(Excel 2010)

    関数の挿入ダイアログから抽出したExcel 2010の関数情報をリスト…

コメント

  • コメント (0)

  • トラックバックは利用できません。

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP