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コントロールを使うよりも、デザイン性に優れたフォームに仕上げることができます。

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

「できたてしずおか茶」が美味しい。前のページ

[VBA]自動的にフォントサイズを調整する疑似テキストボックス次のページ

関連記事

  1. Office アドイン

    [Officeアドイン]ワークシートで選択範囲を変更したときに発生するイベント

    ワークシート上で選択範囲の変更を検知する際、VBAでは通常「Works…

  2. Office アドイン

    [Office用アプリ]カレンダーから日付入力

    カレンダーから日付を選ぶだけで選択中のセルに日付を入力できるコンテンツ…

  3. Office関連

    指定したフォルダ内の画像ファイルを一括挿入するPowerPointマクロ

    大量の画像ファイルを1枚/1スライドで挿入する必要があり、…

  4. アイコン一覧

    Office 365アイコン(imageMso)一覧(I)

    Office 365のデスクトップ版Officeアプリケーション(Wo…

  5. Office アドイン

    Office Scripts機能によってWeb版Officeの操作を自動化する

    前回、Ignite 2019で発表されたPower Automate(…

  6. Office関連

    [リボン・カスタマイズ]アクティブシートにより表示するグループを切り替える。

    Excelで、選択しているシートによって表示するグループを切り替えたい…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

Translate

最近の記事

アーカイブ

PAGE TOP