vba - アクセス2010VBAフォーム-自動フォームサイズ変更

Question

オフィスで使用するフォームに記入しましたが、別のコンピューターで開いたときにフォームのサイズが変更されません。代わりに、スクロールバーが表示されます。フォームとコントロールのサイズを自動的に変更するにはどうすればよいですか？

score 5 · Accepted Answer

フォームに追加できる VBA コードを次に示します。これにより、ユーザーがモニターのウィンドウをどれだけ大きくしたり小さくしたり、モニターの解像度に関係なく、フォームの外観が同じになります。

Ctrlまた、キーを押しながらマウスホイールを上下にスクロールする (または、キーを押しShiftながら+キーまたはキーを押す) と、テキストを拡大または縮小でき-ます。

この機能を使用するには、Access を開き、フォームをデザインビューで開きます。まず、フォームの画像を右クリックして、Form Header/Footer.

ヘッダーとフッターをフォームに追加しない場合、以下のコードはエラーになります。ただし、フォームにヘッダーとフッターを表示したくない場合は、ヘッダーとフッターの両方の高さを縮小できます。

フォームの左上、タブのすぐ下にある小さなボックスをクリックして、フォーム自体を選択します。

これにより、Property Sheet.

Property Sheetフォームのを表示するには (まだ表示されていない場合)、Altキーを押しながらキーを押しEnterます。

タブを選択しEventます。

[Event Procedure]次に、フォーム自体の背後にある次の 5 つのイベントにリテラルテキストを追加する必要があります。

ロード中

キーアップ時

キーダウン時

サイズ変更時

マウスホイール上

これらのイベントの横にあるテキストボックスにリテラルテキスト[Event Procedure]を入力するか、各イベントの横にある省略記号 (...) ボタンをクリックCode Builderして、ポップアップメニューから選択することができます。

次のようになります。

...

また、イベントのリストの一番下で、Key PreviewプロパティをYes次のように変更する必要もあります。

Scroll Bars最後に、フォームがコンテンツと重ならないように、フォームをオフにすることをお勧めします。これを行うには、デザインビューでフォームのFormatタブに移動し、プロパティをに変更します。Property SheetScroll BarsNeither

次に、VBA コードを追加するには、長押ししてAltVBAF11エディターを表示します。

VBA エディターに入ったら、フォルダーForm_YourFormNameの下のオプションをダブルクリックします。Microsoft Access Class Objects

フォルダーが表示されない場合はMicrosoft Access Class Objects、デザインビューでフォームに戻り、[Event Procedure]変更したイベントのリテラルテキストの横にある省略記号 (...) をクリックします。

Form_YourFormNameこれにより、VBA エディターに戻り、コード領域内にいるはずです。そこにはすでにいくつかのコードがありますが、次のステップに進む前にすべてを消去できます。

次に、右側の画面のメイン部分で、以下のコードをコピーして貼り付けるだけで完了です。

Option Compare Database
Option Explicit


'Set an unchangeable variable to the amount (10% for example) to increase or
'decrease the font size with each zoom, in or out.
Const FONT_ZOOM_PERCENT_CHANGE = 0.1


'Create the fontZoom and ctrlKeyIsPressed variables outside of
'the sub definitions so they can be shared between subs
Private fontZoom As Double
Private ctrlKeyIsPressed As Boolean


'Create an enum so we can use it later when pulling the data out of the "Tag" property
Private Enum ControlTag
    FromLeft = 0
    FromTop
    ControlWidth
    ControlHeight
    OriginalFontSize
    OriginalControlHeight
End Enum


Private Sub Form_Load()
    'Set the font zoom setting to the default of 100% (represented by a 1 below).
    'This means that the fonts will appear initially at the proportional size
    'set during design time. But they can be made smaller or larger at run time
    'by holding the "Shift" key and hitting the "+" or "-" key at the same time,
    'or by holding the "Ctrl" key and scrolling the mouse wheel up or down.
    fontZoom = 1

    'When the form loads, we need to find the relative position of each control
    'and save it in the control's "Tag" property so the resize event can use it
    SaveControlPositionsToTags Me
End Sub


Private Sub Form_Resize()
    'Set the height of the header and footer before calling RepositionControls
    'since it caused problems changing their heights from inside that sub.
    'The Tag property for the header and footer is set inside the SaveControlPositionsToTags sub
    Me.Section(acHeader).Height = Me.WindowHeight * CDbl(Me.Section(acHeader).Tag)
    Me.Section(acFooter).Height = Me.WindowHeight * CDbl(Me.Section(acFooter).Tag)

    'Call the RepositionControls Sub and pass this form as a parameter
    'and the fontZoom setting which was initially set when the form loaded and then
    'changed if the user holds the "Shift" key and hits the "+" or "-" key
    'or holds the "Ctrl" key and scrolls the mouse wheel up or down.
    RepositionControls Me, fontZoom
End Sub


Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

    'PURPOSE: Make the text on the form bigger if "Shift" and "+" are pressed
    'at the same time and smaller if "Shift" and "-" are pressed at the same time.
    'NOTE: Using the "Ctrl" key instead of the "Shift" key conflicts with Access's
    'default behavior of using "Ctrl -" to delete a record, so "Shift" is used instead

    'Was the "Shift" key being held down while the Key was pressed?
    Dim shiftKeyPressed As Boolean
    shiftKeyPressed = (Shift And acShiftMask) > 0

    'If so, check to see if the user pressed the "+" or the "-" button at the
    'same time as the "Shift" key. If so, then make the font bigger/smaller
    'by the percentage specificed in the FONT_ZOOM_PERCENT_CHANGE variable.
    If shiftKeyPressed Then

        Select Case KeyCode
            Case vbKeyAdd
                fontZoom = fontZoom + FONT_ZOOM_PERCENT_CHANGE
                RepositionControls Me, fontZoom

                'Set the KeyCode back to zero to prevent the "+" symbol from
                'showing up if a textbox or similar control has the focus
                KeyCode = 0

            Case vbKeySubtract
                fontZoom = fontZoom - FONT_ZOOM_PERCENT_CHANGE
                RepositionControls Me, fontZoom

                'Set the KeyCode back to zero to prevent the "-" symbol from
                'showing up if a textbox or similar control has the focus
                KeyCode = 0

        End Select

    End If

    'Detect if the "Ctrl" key was pressed. This variable
    'will be used later when we detect a mouse wheel scroll event.
    If (Shift And acCtrlMask) > 0 Then
        ctrlKeyIsPressed = True
    End If

End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    'Change the ctrlKeyIsPressed variable to false when
    'any key is let up. This will make sure the form text does
    'not continue to grow/shrink when the mouse wheel is
    'scrolled after the ctrl key is pressed and let up.
    ctrlKeyIsPressed = False
End Sub


Private Sub Form_MouseWheel(ByVal Page As Boolean, ByVal Count As Long)
    'If the "Ctrl" key is also being pressed, then zoom the form in or out
    If ctrlKeyIsPressed Then
        Debug.Print ctrlKeyIsPressed
        'The user scrolled up, so make the text larger
        If Count < 0 Then

            'Make the font bigger by the percentage specificed
            'in the FONT_ZOOM_PERCENT_CHANGE variable
            fontZoom = fontZoom + FONT_ZOOM_PERCENT_CHANGE
            RepositionControls Me, fontZoom

        'The user scrolled down, so make the text smaller
        ElseIf Count > 0 Then

            'Make the font smaller by the percentage specificed
            'in the FONT_ZOOM_PERCENT_CHANGE variable
            fontZoom = fontZoom - FONT_ZOOM_PERCENT_CHANGE
            RepositionControls Me, fontZoom
        End If

    End If
End Sub


Public Sub SaveControlPositionsToTags(frm As Form)
On Error Resume Next

    Dim ctl As Control

    Dim ctlLeft As String
    Dim ctlTop As String
    Dim ctlWidth As String
    Dim ctlHeight As String
    Dim ctlOriginalFontSize As String
    Dim ctlOriginalControlHeight As String

    For Each ctl In frm.Controls

        'Find the relative position of this control in design view
        'e.g.- This control is 5% from the left, 10% from the top, etc.
        'Those percentages can then be saved in the Tag property for this control
        'and used later in the form's resize event
        ctlLeft = CStr(Round(ctl.Left / frm.Width, 4))
        ctlTop = CStr(Round(ctl.Top / frm.Section(ctl.Section).Height, 4))
        ctlWidth = CStr(Round(ctl.Width / frm.Width, 4))
        ctlHeight = CStr(Round(ctl.Height / frm.Section(ctl.Section).Height, 4))

        'If this control has a FontSize property, then capture the
        'control's original font size and the control's original height from design-time
        'These will be used later to calculate what the font size should be when the form is resized
        Select Case ctl.ControlType
            Case acLabel, acCommandButton, acTextBox, acComboBox, acListBox, acTabCtl, acToggleButton
                ctlOriginalFontSize = ctl.FontSize
                ctlOriginalControlHeight = ctl.Height
        End Select

        'Add all this data to the Tag property of the current control, separated by colons
        ctl.Tag = ctlLeft & ":" & ctlTop & ":" & ctlWidth & ":" & ctlHeight & ":" & ctlOriginalFontSize & ":" & ctlOriginalControlHeight

    Next

    'Set the Tag properties for the header and the footer to their proportional height
    'in relation to the height of the whole form (header + detail + footer)
    frm.Section(acHeader).Tag = CStr(Round(frm.Section(acHeader).Height / (frm.Section(acHeader).Height + frm.Section(acDetail).Height + frm.Section(acFooter).Height), 4))
    frm.Section(acFooter).Tag = CStr(Round(frm.Section(acFooter).Height / (frm.Section(acHeader).Height + frm.Section(acDetail).Height + frm.Section(acFooter).Height), 4))

End Sub


Public Sub RepositionControls(frm As Form, fontZoom As Double)
On Error Resume Next

    Dim formDetailHeight As Long
    Dim tagArray() As String

    'Since "Form.Section(acDetail).Height" usually returns the same value (unless the detail section is tiny)
    'go ahead and calculate the detail section height ourselves and store it in a variable
    formDetailHeight = frm.WindowHeight - frm.Section(acHeader).Height - frm.Section(acFooter).Height

    Dim ctl As Control

    'Loop through all the controls on the form
    For Each ctl In frm.Controls

        'An extra check to make sure the Tag property has a value
        If ctl.Tag <> "" Then

            'Split the Tag property into an array
            tagArray = Split(ctl.Tag, ":")

            If ctl.Section = acDetail Then
                'This is the Detail section of the form so use our "formDetailHeight" variable from above
                ctl.Move frm.WindowWidth * (CDbl(tagArray(ControlTag.FromLeft))), _
                                   formDetailHeight * (CDbl(tagArray(ControlTag.FromTop))), _
                                   frm.WindowWidth * (CDbl(tagArray(ControlTag.ControlWidth))), _
                                   formDetailHeight * (CDbl(tagArray(ControlTag.ControlHeight)))
            Else
                ctl.Move frm.WindowWidth * (CDbl(tagArray(ControlTag.FromLeft))), _
                                   frm.Section(ctl.Section).Height * (CDbl(tagArray(ControlTag.FromTop))), _
                                   frm.WindowWidth * (CDbl(tagArray(ControlTag.ControlWidth))), _
                                   frm.Section(ctl.Section).Height * (CDbl(tagArray(ControlTag.ControlHeight)))
            End If

            'Now we need to change the font sizes on the controls.
            'If this control has a FontSize property, then find the ratio of
            'the current height of the control to the form-load height of the control.
            'So if form-load height was 1000 (twips) and the current height is 500 (twips)
            'then we multiply the original font size * (500/1000), or 50%.
            'Then we multiply that by the fontZoom setting in case the user wants to
            'increase or decrease the font sizes while viewing the form.
            Select Case ctl.ControlType
                Case acLabel, acCommandButton, acTextBox, acComboBox, acListBox, acTabCtl, acToggleButton
                    ctl.FontSize = Round(CDbl(tagArray(ControlTag.OriginalFontSize)) * CDbl(ctl.Height / tagArray(ControlTag.OriginalControlHeight))) * fontZoom
            End Select

        End If

    Next

End Sub

以下は、縮小したときのフォームのスクリーンショットです。

前：

後：

Ctrlまた、キーを押しながらマウスホイールを上にスクロールすると (または、Shiftキーを押しながらキーを押すと) 、テキストを大きくすることができ+ます。

Ctrlまた、キーを押しながらマウスホイールを下にスクロールすると (または、Shiftキーを押しながらキーを押すと) 、テキストを小さくすることができ-ます。

score 3 · Accepted Answer

いくつかの注意：

コントロールをフォームに固定して、フォームに合わせてサイズを変更できるようにする方法をご覧ください。
ユーザーが持つ最小の画面サイズで適切に表示されるようにフォームを設計します。
ユーザーがアプリケーションをどのように操作するかを考えることが重要です。Accessがすべてを魔法のようにリフローしてサイズ変更することを期待することはできません。これは、アプリケーションの設計者として考える必要があることです。
したがって、フォーム上のコントロールの数を制限し、オフィスで妥当な最小の画面解像度で正しく表示されるように、コントロールを十分に小さくしてください。
バーを表示したくない場合は、フォームのscrollbarsプロパティを確認してください。
使用できるさまざまなフォームスタイルを調べてください。Access2007以降では、タブでフォームを使用できます。それらをポップアップさせて、サイズ変更されないようにすることもできます。
次のフォームプロパティを調べて、さまざまな組み合わせを試して、目的の効果を取得します。

vba - アクセス2010VBAフォーム-自動フォームサイズ変更

2 に答える 2

Related

Reference