Zoom je nach Bildschirmauflösung anpassen


                            Hallo Carsten



schreibe fogenden Code in die Datei unter DieseArbeitsmappe.



Option Explicit

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Public Enum ScreenArgs

    HORIZONTAL

    VERTIKAL

End Enum

Public Function ScreenResolution(HV As ScreenArgs) As Long

    If HV = 0 Or HV = 1 Then ScreenResolution = GetSystemMetrics(HV)

End Function


Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Select Case ScreenResolution(0)
Case 1152
ActiveWindow.Zoom = 110
Case 1024
ActiveWindow.Zoom = 100
Case 800
ActiveWindow.Zoom = 75
Case 640
ActiveWindow.Zoom = 60
End Select
End Sub

Bitte keine Mail, Probleme sollten im Forum gelöst werden.

Microsoft MVP für Excel

Das Forum lebt auch von den Rückmeldungen.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Public Sub Main() Dim gWidth As Integer, gHeight As Integer gWidth = GetSystemMetrics(SM_CXSCREEN) gHeight = GetSystemMetrics(SM_CYSCREEN) MsgBox "Bildschirmbreite: " & Chr(9) & gWidth & Chr(13) & "Bildschirmhöhe: " & Chr(9) & gHeight End Sub Falls Code vorhanden wurde dieser getestet unter Betriebssystem XP Pro und Excel Version XP SBE. Bitte keine Mail, Probleme sollten im Forum gelöst werden. Microsoft MVP für Excel Das Forum lebt auch von den Rückmeldungen.

Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Public Enum ScreenArgs HORIZONTAL VERTIKAL End Enum Public Function ScreenResolution(HV As ScreenArgs) As Long If HV = 0 Or HV = 1 Then ScreenResolution = GetSystemMetrics(HV) End Function Sub Set_Zoom() Select Case ScreenResolution(0) Case 1152 ActiveWindow.Zoom = 110 Case 1024 ActiveWindow.Zoom = 100 Case 800 ActiveWindow.Zoom = 75 Case 640 ActiveWindow.Zoom = 60 End Select End Sub Gruß Carsten

Hi karsten,

da gibts in der Recherche unter Zoom einige Beiträge,...

Doch ich persöhnlich hab mir meine Dateien noch folgendermaßen erweitert, indem ich per makrorekorder folgendes aufgezeichnet hatte, und es dan noch gefinnischt hat per feineinstellung der werte in der Aufzeichnug, und durch die Spaltenbreite.

Stell mal zunächst deine Auflösung auf 100% , dann

1. Makrorekorder starten ( Namen geben usw. ) ...
2. markiere deine Spalten die zu sehen sind ( die also im sichtbaren Bereich liegen ),
je nach Spaltenbreite deiner Spalten siehst du vielleicht A bis M.
3. Markier dann A bis M
4. geh oben im Excelregister auf Ansicht
5. dort auf Zoom, und dann auf " an Markierung anpassen "
6. wähle vielleicht noch kurz irgend eine Zelle ( um die Auswahl wieder auf zu heben )
7. und beende das Makro.

8. jetzt musst du nur noch die ganzen VBA Anweisungen dieses Makros in das des Tabellenbalttes übernehmen, und zwar in ...


Private Sub Worksheet_Activate()
sieht dann zB. so aus :

Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Range("A1:N1").Select
Range("A1").Activate
ActiveWindow.Zoom = True
Range("A1").Select
Application.ScreenUpdating = True
End Sub




----------------------------------------------



das tolle daran ist , das sich die Datei / Tabelle nun selbst automatisch auf die 

Auflösung oder den gerade verwendeten Monitor selbst einstellt, ohne das du da was

einstellen musst.



Viel Spass



Gruß udo

Beliebteste Forumthreads (12 Monate)

Zoom je nach Bildschirmauflösung anpassen

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

13 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zoom je nach Bildschirmauflösung anpassen

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

13 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread