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. Excel

    [Python in Excel]Excelの値として出力するかPythonオブジェクトとして出力す…

    昨日はパブリックプレビューがリリースされたPython in Exce…

  2. Office関連

    [PowerShell]Word文書の透かし文字を変更するスクリプト

    MSDNフォーラムに「PowerShellを使って、Word文書の透か…

  3. Excel

    Acrobatを利用してPDFファイルのページ数を取得するVBAマクロ

    前回の記事ではPowerShell+iTextSharp、前々回の記事…

  4. Office関連

    [PowerPoint]ドキュメントを開いたときに自動的にマクロを実行する

    ドキュメントを開いたときに自動的にマクロを実行する方法として、Word…

  5. Office関連

    OneNote + Google Apps Scriptで定期的にWebサイトのキャプチャーを撮る方…

    「“OneNote”がアップデート、URLをメールで送るだけでスクリー…

  6. Office関連

    文字列を指定した文字数で分割するVBA関数

    "01234567890123456789012…"というような長い文…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

Translate

最近の記事

アーカイブ

PAGE TOP