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

 > 

すべての返信

  • Question
    サインインして投票
    0
    サインインして投票

    方法は無いはずです。

    VB.NETのフォームで使われているWindowsのコントロールはオーナードローという仕組みを使って見た目を変えることができます。ですが、VBAのフォームはOfficeアプリケーションが独自に実装しているもので、Windowsコントロールのように見た目を変えるための方法が提供されていません。

    あえて行うならImageコントロールを張り付けて使うということになるかと思います。

    甕星

    2015年10月18日 21:05
    |
  • Question
    サインインして投票
    0
    サインインして投票
    質問者さんの「平面的なもの」が何を指しているのかわかりませんが、Windows 8から導入されたModern UIのことであれば、Officeを含む従来アプリケーションには無理で、Modern UI専用に１から作り直す必要があります。ですのでVBAでは実現できません。そもそもOfficeで実現されていないことをなぜVBAで実現したいのかが理解できません。
    2015年10月18日 21:22
    |
  • Question
    サインインして投票
    1
    サインインして投票
    こんにちは。

    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に強いこだわりが無いのであれば、標準的なコントロールを使用した方がトラブルは無いだろうと思います。
    2015年10月19日 2:41
    |
  • Question
    サインインして投票
    0
    サインインして投票

    平面にしたいのはフォームそのものですか？それとも配置するコントロールですか？

    非常に原始的なやり方ですが、ボタンコントロールであれば４隅をラベルで塗りつぶすとか。

    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


    2015年11月11日 1:40
    |