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関連

    蛍光ペンでマークした部分の文字数をカウントするWordマクロ

    Twitterでたまたま下記のツイートを見つけたので、簡単な処理を考え…

  2. Office関連

    各スライドに配置されたオートシェイプからテキストを取得するPowerPointマクロ

    各スライドに配置されたオートシェイプからテキストを抜き出す処理を考えて…

  3. Office関連

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

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

  4. Office アドイン

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

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

  5. Office関連

    [Excel Services ECMAScript]選択範囲が変更されたときのイベントを利用する。…

    埋め込んだExcelワークブックの、選択範囲が変更されたときのイベント…

  6. Office関連

    Office 2013 カスタマープレビュー版の「Spy Utility」

    たまたま見つけたWebページ「Office2013のデバッグ用ツールが…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

Translate

Chinese (Simplified)Chinese (Traditional)EnglishFrenchGermanJapaneseKoreanRussianSpanish

最近の記事

アーカイブ

PAGE TOP