Adattamento foglio con risoluzioni diverse

Question

Salve a tutti,

eccomi all'ennesimo quesito:

ho costruito un'applicazione sul computer del lavoro, ma quando l'ho portata sul notebook di casa, avendo uno  schermo 16/9

il foglio di lavoro risulta sballato.

Volevo sapere se esiste un'istruzione o metodo che adatta il foglio alla risoluzione/schermo del pc.

Grazie,

Marco

Answer 1

office 2016

windows 7

ti allego foto errore:

Answer 2

In che riga esattamente?

Che versione di office e windows?

Answer 3

Grazie Casanmaner,

ma mi da errore su queste istruzioni:

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

    Public Declare PtrSafe Function GetSystemMetrics32 Lib "user32"

                                    Alias "GetSystemMetrics" (ByVal nIndex as Long) As Long

  #Else

    Public Declare Function GetSystemMetrics32 Lib "user32" _

                            Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long

  #End If

Answer 4

La sub CalcolaWSRatio è richiamata anche con l'evento activate dei due fogli.

Non mi ero reso conto che i fogli erano due all'inizio :-)

Questo quello che vedo con il mio schermo 1.366x768

Answer 5

Ciao per curiosità prova questo file che è il tuo dove ho aggiunto un modulo M_AdattaUserForm che contiene del codice (che ho trovato nelle mie ricerche) per adattare le userform in base alla risoluzione di partenza con cui è stato creato.

Ho fatto anche una modifica aggiungendo una procedura che modifica anche lo zoom del foglio di calcolo.

Vedi se è quello che cerchi:

gioco

Questo è il codice presente nel modulo:

'---

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) As Long

  #Else

    Public Declare Function GetSystemMetrics32 Lib "user32" _

                            Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long

  #End If

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

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

  Public Const WorksheetBaseZoom as Long = 100     '<-- Inserire in termini assoluti la percentuale dello zoom di partenza del foglio

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 Long, frmIndex As Long

    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

Sub DisplayMonitorInfo()

    Dim w As Long, h As Long

    w = GetSystemMetrics32(0) ' width in points

    h = GetSystemMetrics32(1) ' height in points

    MsgBox Format(w, "#,##0") & " x " & Format(h, "#,##0"), _

    vbInformation, "Monitor Size (width x height)"

End Sub

Sub CalcolaWsRatio()

    Dim AvgRatio As Long

    Dim RatioX As Long

    Dim RatioY As Long

    Dim ActResX As Long

    Dim ActResY As Long

    ActResX = GetSystemMetrics32(0)

    ActResY = GetSystemMetrics32(1)

    RatioX = (ActResX * WorksheetBaseZoom) / scrBaseResX

    RatioY = (ActResY * WorksheetBaseZoom) / scrBaseResY

    AvgRatio = (RatioX + RatioY) / 2

    ThisWorkbook.Windows(1).Zoom = AvgRatio

End Sub

'---

La funzione "AdattaUserForm" è inserita negli eventi activate o inizialize delle userform.

La Sub CalcolaWsRatio è prensente in Workbook_Open.

P.s. in questo file ho disabilitato il Cancel della chiusura delle form con la x ;)