UserForm ridimensionabile

Question

Mi sono accorto che utilizzando il file excel a cui ho abbinato una gestione tramite UserForm, questa aperta in un altro PC con risoluzione grafica diversa da dove ho costruito la UserForm, esce dalle dimensioni dello schermo. Volevo chiedervi se é possibile e se esistone delle istruzioni che mi permettano di ridimensionare la UserForm a piacimento e scorvervi all'interno utilizzano delle ScroolBars veticali e orizzontali.

Grazie

Answer 1

Ciao Giuseppe,

La tua risposta a Mauro mi ha sorpreso un po' e mette in dubbio la mia comprensione delle tue esigenze. Comunque, per vedere le barre di scorrimento anche con una risoluzione bassa dello schermo, forse prova qualcosa del genere;

'=========>>

Option Explicit

'--------->>

Private Sub UserForm_Initialize()

  With Application

  .WindowState = xlMaximized

  Zoom = Int((Application.Width) / Me.Width * 100)

  Width = .Width - 10

  Height = .Height - 10

  End With

End Sub

'--------->>

Private Sub UserForm_Zoom(Percent As Integer)

    Dim dZoomFactor As Double

    Percent = Application.Min(390, Zoom)

    If Percent > 99 Then

        ScrollBars = fmScrollBarsBoth

        ScrollLeft = 0

        ScrollTop = 0

        dZoomFactor = Width * Percent / 100

        ScrollWidth = dZoomFactor - 10

        dZoomFactor = Height * Percent / 100

        ScrollHeight = dZoomFactor - 10

    Else

        ScrollBars = fmScrollBarsNone

        ScrollLeft = 0

        ScrollTop = 0

    End If

End Sub

'--------->>

Private Sub TextBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    TextBox1.Font.Bold = True

End Sub

'--------->>

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    TextBox1.Font.Bold = False

End Sub

'<<=========

===

Regards,

Norman

Answer 2

Non so se sia esattamente quello che cerchi ma io, cercando un po' in internet e adattando alle mie esigenze, ho trovato e sto utilizzando qualcosa del genere.

In un modulo standard inserisco:

'---

Option Private Module

Option Explicit

#If VBA7 Then 'riga dichiarata in caso di office a 64bit

  Public Declare PtrSafe Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex&) As Long

#Else

  Public Declare Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex&) As Long

#End If

  Public Const scrBaseResX As Long = 1366  '<-- Inserire la risuluzione originaria con cui si è costruita la userform PRIMO VALORE

  Public Const scrBaseResY As Long = 768   '<-- Inserire la risuluzione originaria con cui si è costruita la userform SECONDO VALORE

Sub AdattaUserForm(frm As String) 'nome della userform da adattare

    Dim frmBaseWidth As Long

    Dim frmBaseHeight As Long

    Dim frmBaseLeft As Long

    Dim frmBaseTop As Long

    Dim frmBaseZ As Long

    Dim AvgRatio As Long

    Dim RatioX As Long

    Dim RatioY As Long

    Dim avgFrmRatio As Variant

    Dim ActResX As Long

    Dim ActResY As Long

    Dim idi As Integer, frmIndex As Integer

    For idi = 0 To UserForms.Count

        If UserForms(idi).Name = frm Then

            frmIndex = idi

            Exit For

        End If

    Next idi

    frmBaseWidth = UserForms(frmIndex).Width

    frmBaseHeight = UserForms(frmIndex).Height

    frmBaseLeft = UserForms(frmIndex).Left

    frmBaseTop = UserForms(frmIndex).Top

    frmBaseZ = UserForms(frmIndex).Zoom

    ActResX = GetSystemMetrics32(0)

    ActResY = GetSystemMetrics32(1)

    RatioX = (ActResX * frmBaseZ) / scrBaseResX

    RatioY = (ActResY * frmBaseZ) / scrBaseResY

    AvgRatio = (RatioX + RatioY) / 2

    avgFrmRatio = AvgRatio / frmBaseZ

    UserForms(frmIndex).Move frmBaseLeft * avgFrmRatio, _

            frmBaseTop * avgFrmRatio, _

            frmBaseWidth * avgFrmRatio, _

            frmBaseHeight * avgFrmRatio

    UserForms(frmIndex).Zoom = AvgRatio

End Sub

'---

Poi nell'evento Initialize della UserForm inserisco, solitamente come ultima riga di comando, questo comando:

Call AdattaUserForm(Me.Name)

Answer 3

Ciao Mauro,

mi "intrufolo" nella discussione: e se dovessi ridimensionare tutto la UserForm, quindi anche i controlli interni alla stessa? Come posso fare?

Purtroppo mi sono accorto solo dopo lo sviluppo che gli utenti usano risoluzioni da talpa.

Uso Excel 2010.

Grazie

S.

Answer 4

Ok.

Grazie del chiarimento.