質問者
VBAでのフォーム オブジェクトを立体的なデザインから平面的なデザインにしたい

質問
すべての返信
-
こんにちは。
WebBrowser経由であればBootstrap等のフレームワークやJSライブラリが使用できますので、ActiveXコントロールよりは自由度の高いデザインができるかと思います。
'UserForm1 '※ WebBrowserコントトール要配置 '※ Microsoft HTML Object Library(mshtml.tlb)要参照 Option Explicit Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long 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 '外観は好みに応じて適当に設定 style = style And Not &HC00000 SetWindowLong hForm, -16, style DrawMenuBar hForm 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 & "</head>" & vbNewLine src = src & "<body>" & vbNewLine src = src & " <div class=""container"">" & vbNewLine 'ボタン追加 src = src & " <button id=""button1"" class=""btn btn-primary"">button1</button>" & vbNewLine src = src & " <button id=""button2"" class=""btn btn-success"">button2</button>" & vbNewLine src = src & " <button id=""button3"" class=""btn btn-info"">button3</button>" & vbNewLine src = src & " <button id=""button4"" class=""btn btn-danger"">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 VBA.Unload Me End Function Private Sub UserForm_Resize() 'ユーザーフォームに合わせてWebBrowserリサイズ With Me.WebBrowser1 .Width = Me.Width .Height = Me.Height End With End Sub
ただ、UIに強いこだわりが無いのであれば、標準的なコントロールを使用した方がトラブルは無いだろうと思います。 -
平面にしたいのはフォームそのものですか?それとも配置するコントロールですか?
非常に原始的なやり方ですが、ボタンコントロールであれば4隅をラベルで塗りつぶすとか。
Option Explicit Private Sub UserForm_Initialize() Dim c As Object Dim l As New Collection For Each c In Me.Controls Select Case TypeName(c) Case "CommandButton", "ToggleButton" l.Add c End Select Next For Each c In l With Me.Controls.Add("Forms.Label.1") .Left = c.Left .Top = c.Top .Width = 2 .Height = c.Height End With With Me.Controls.Add("Forms.Label.1") .Left = c.Left .Top = c.Top .Width = c.Width .Height = 2 End With With Me.Controls.Add("Forms.Label.1") .Left = c.Left + c.Width - 2 .Top = c.Top .Width = 2 .Height = c.Height End With With Me.Controls.Add("Forms.Label.1") .Left = c.Left .Top = c.Top + c.Height - 2 .Width = c.Width .Height = 2 End With Next End Sub