Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
18.04.2024 18:04:29
Formel fehler Wert#
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1056to1060
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1056to1060
1056to1060
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Bildschirmauflösung/ Zoom

Bildschirmauflösung/ Zoom
07.03.2009 13:56:16
Bea
Hallo
Mit unten aufgeführten Code findet die Bildschirmanpassung in meiner Mappe statt.
Was ich, nicht verstehe bzw. gerne möchte(leider nicht hin bekomme):
Meine Mappe besteht aus 18 Blätter, die Anpassung ist soweit ok(1280x1024;75).
Nun möchte ich aber das zwei bestimmte Blätter, Tab1 mit 93 und Tab9 mit 81 Zoom geöffnet werden.
Wie muß der Code ergänzt bzw. geändert werden?
Gruß
Bea
Option Explicit

Private Sub Workbook_Open()
Select Case GetScreenRes
Case "1280x1024"
ActiveWindow.Zoom = 75
Case "1024x768"
ActiveWindow.Zoom = 85
Case "800x600"
ActiveWindow.Zoom = 100
Case Else
MsgBox "unbekannte Auflösung"
End Select
End Sub




Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Select Case GetScreenRes
Case "1280x1024"
ActiveWindow.Zoom = 75
Case "1024x768"
ActiveWindow.Zoom = 85
Case "800x600"
ActiveWindow.Zoom = 100
Case Else
MsgBox "unbekannte Auflösung"
End Select
End Sub


Option Explicit
Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hdc As Long, ByVal nIndex As Long) As Long
Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Declare Function ReleaseDC Lib "user32" _
(ByVal hWnd As Long, ByVal hdc As Long) As Long
Declare Sub ShowWindow Lib "user32" _
(ByVal hWnd As Long, ByVal nCmdShow As Long)
Const HORZRES = 8
Const VERTRES = 10
Function GetScreenRes()
Dim lRval As Long
Dim lDC As Long
Dim lHSize As Long
Dim lVSize As Long
lDC = GetDC(0&)
lHSize = GetDeviceCaps(lDC, HORZRES)
lVSize = GetDeviceCaps(lDC, VERTRES)
lRval = ReleaseDC(0, lDC)
GetScreenRes = lHSize & "x" & lVSize
End Function


22
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bildschirmauflösung/ Zoom
07.03.2009 14:12:24
Renee
Hi Bea,
Vielleicht so:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Select Case GetScreenRes
Case "1280x1024"
ActiveWindow.Zoom = 75
Case "1024x768"
ActiveWindow.Zoom = 85
Case "800x600"
ActiveWindow.Zoom = 100
Case Else
MsgBox "unbekannte Auflösung"
End Select
Select Case sh.Name
Case "Tab1"
ActiveWindow.Zoom = 93
Case "Tab9"
ActiveWindow.Zoom = 81
End Select
End Sub


GreetZ Renée
AW: Bildschirmauflösung/ Zoom
07.03.2009 14:35:27
Bea
Hi Renée
VBA kann ja vieles erleichtern wenn man weiß was man will und versteht,
oder ein Qual, wenn man es nicht versteht und trotzdem damit versucht.
Hab ein bischen Nachsicht für folgende Frage.
Deine Ergänzung funktioniert einwandfrei, was aber bei einer anderen Auflösung?
Die 93 bzw. 81 bleiben ja bestehen.
Es geht eigentlich darum, das sich auf diesen beiden Blättern bildfühlende Grafiken
befinden und bei einer Auflösung von 800x600 paßt dann der Zoom ja nicht mehr.
Verstehtst du was ich meine?
Gruß
Bea
Anzeige
AW: Bildschirmauflösung/ Zoom
07.03.2009 15:18:36
Bea
Hallo,
hab mal noch ein bischen rumprobiert und folgendes ist dabei herausgekommen:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Select Case GetScreenRes
Case "1280x1024"
ActiveWindow.Zoom = 75
Case "1024x768"
ActiveWindow.Zoom = 85
Case "800x600"
ActiveWindow.Zoom = 100
Case Else
MsgBox "unbekannte Auflösung"
End Select
Select Case Sh.Name
Case "Tab1"
Range("A1:S50").Select
ActiveWindow.Zoom = True
Range("A1").Select
Case "Tab9"
Range("A1:O38").Select
ActiveWindow.Zoom = True
Range("A1").Select
End Select
End Sub


Wie ist eure Meinung?
Kann man das so machen, funktionieren tut es jedenfalls.
Gruß
Bea

Anzeige
AW: Bildschirmauflösung/ Zoom
07.03.2009 15:49:06
Renee
Hi Bea,
Ja das kann frau so machen.
Wieso auch nicht, wenn es funktioniert?... und das tut es ja!
GreetZ Renée
;-) Danke owT
07.03.2009 16:01:54
Bea
.
ich würde es eventuell...
07.03.2009 16:34:03
Tino
Hallo,
...dies nur von der Vertikalen Bildschirmauflösung abhängig machen.
Es gibt heute zu viele andere Auflösungen bei mir z. Bsp. 1680*1050
Beispiel:
kommt als Code in DieseArbeitsmappe 
Option Explicit 
'hier die vertikale Auflösung angeben, wenn die Datei erstellt wird 
Private Const ErstelltBei As Long = 1050 
 
Private Sub Workbook_Open() 
 Dim Faktor As Double 
 Faktor = 100 / ErstelltBei * ScreenResolution 
 ActiveWindow.Zoom = Faktor 
End Sub 
 
Private Sub Workbook_SheetActivate(ByVal Sh As Object) 
 Dim Faktor As Double 
 Faktor = 100 / ErstelltBei * ScreenResolution 
 ActiveWindow.Zoom = Faktor 
End Sub

Modul Modul1 

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long 
 
Function ScreenResolution() 
  ScreenResolution = GetSystemMetrics(1) 
End Function


Gruß Tino

Anzeige
oder doch besser beide
07.03.2009 16:53:55
Tino
Hallo,
und den mit der größten Änderung anwenden.
Beispiel:
kommt als Code in DieseArbeitsmappe 
Option Explicit 
'hier die vertikale Auflösung angeben, wenn die Datei erstellt wird 
Private Const LVertikal As Long = 1050 
Private Const LHorizonatal As Long = 1680 
 
Private Sub Workbook_Open() 
 Dim FaktorV As Double, FaktorH As Double 
 FaktorV = 100 / LVertikal * ScreenResolution(1) 
 FaktorH = 100 / LHorizonatal * ScreenResolution(0) 
 ActiveWindow.Zoom = Application.WorksheetFunction.Min(FaktorV, FaktorH) 
End Sub 
 
Private Sub Workbook_SheetActivate(ByVal Sh As Object) 
 Dim FaktorV As Double, FaktorH As Double 
 FaktorV = 100 / LVertikal * ScreenResolution(1) 
 FaktorH = 100 / LHorizonatal * ScreenResolution(0) 
 ActiveWindow.Zoom = Application.WorksheetFunction.Min(FaktorV, FaktorH) 
End Sub

Modul Modul1 

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long 
 
Function ScreenResolution(LIndex As Long) 
  ScreenResolution = GetSystemMetrics(LIndex) 
End Function


Gruß Tino

Anzeige
AW: ich würde es eventuell...
07.03.2009 16:55:45
Bea
Hi,
wenn ich das richtig verstanden habe, bezieht sich dein Code nur auf diese eine(1050)
Auflösung. Wie müßte das denn in meinem Beispiel angepaßt werden?
Gruß
Bea

Private Sub Workbook_Open()
Select Case GetScreenRes
Case "1280x1024"
ActiveWindow.Zoom = 74
Case "1280x960"
ActiveWindow.Zoom = 74
Case "1280x800"
ActiveWindow.Zoom = 74
Case "1280x768"
ActiveWindow.Zoom = 74
Case "1280x720"
ActiveWindow.Zoom = 74
Case "1152x864"
ActiveWindow.Zoom = 74
Case "1024x768"
ActiveWindow.Zoom = 65
Case "960x600"
ActiveWindow.Zoom = 55
Case "800x600"
ActiveWindow.Zoom = 48
Case Else
MsgBox "unbekannte Auflösung"
End Select
End Sub




Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Select Case GetScreenRes
Case "1280x1024"
ActiveWindow.Zoom = 74
Case "1280x960"
ActiveWindow.Zoom = 74
Case "1280x800"
ActiveWindow.Zoom = 74
Case "1280x768"
ActiveWindow.Zoom = 74
Case "1280x720"
ActiveWindow.Zoom = 74
Case "1152x864"
ActiveWindow.Zoom = 74
Case "1024x768"
ActiveWindow.Zoom = 65
Case "960x600"
ActiveWindow.Zoom = 55
Case "800x600"
ActiveWindow.Zoom = 48
Case Else
MsgBox "unbekannte Auflösung"
End Select
Select Case Sh.Name
Case "Tab1"
Range("A1:S50").Select
ActiveWindow.Zoom = True
Range("A1").Select
Case "Tab9"
Range("A1:O38").Select
ActiveWindow.Zoom = True
Range("A1").Select
End Select
End Sub


Anzeige
AW: ich würde es eventuell...
07.03.2009 17:05:18
Tino
Hallo,
besser ist der zweite von mir.
Also du gibt einmal an dem Rechner wo Du die Datei erstellst,
die aktuelle Horizontale und Vertikale Auflösung in den Konstanten Werten an. fertig
Dies sind dann die 100%, der Rest wird berechnet. Keine Case keine If usw…
Private Const LVertikal As Long = 1050
Private Const LHorizonatal As Long = 1680
Schreibfehler LHorizonatal ;-), kannst Du ja noch im Code verbessern.
Gruß Tino
AW: ich würde es eventuell...
07.03.2009 17:09:52
Bea
Hi Tino,
glaube ich habe deine Ausführung soweit verstanden, aber...
müßen meine beiden speziellen Seiten
Case "Tab1"
Range("A1:S50").Select
ActiveWindow.Zoom = True
Range("A1").Select
Case "Tab9"
Range("A1:O38").Select
ActiveWindow.Zoom = True
Range("A1").Select
nicht auch noch untergebracht werden?
Gruß
Bea
Anzeige
AW: ich würde es eventuell...
07.03.2009 17:20:48
Tino
Hallo,
wenn es nur auf zwei Tabellen beschränkt sein soll, müssen wir doch eine If mit einbauen.
Name der Tabellen eventuell anpassen.
Private Const LVertikal As Long = 1050
Private Const LHorizonatal As Long = 1680

Private Sub Workbook_Open()
 Dim FaktorV As Double, FaktorH As Double
 If ThisWorkbook.ActiveSheet.Name = "Tab1" Or ThisWorkbook.ActiveSheet.Name = "Tab2" Then
    FaktorV = 100 / LVertikal * ScreenResolution(1)
    FaktorH = 100 / LHorizonatal * ScreenResolution(0)
    ActiveWindow.Zoom = Application.WorksheetFunction.Min(FaktorV, FaktorH)
 End If
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
 Dim FaktorV As Double, FaktorH As Double
 
 If Sh.Name = "Tab1" Or Sh.Name = "Tab2" Then
    FaktorV = 100 / LVertikal * ScreenResolution(1)
    FaktorH = 100 / LHorizonatal * ScreenResolution(0)
    ActiveWindow.Zoom = Application.WorksheetFunction.Min(FaktorV, FaktorH)
 End If


Teste einfach mal, erstell die Datei schließe diese, ändere Deine Auflösung und starte diese nochmal.
Gruß Tino

Anzeige
Sorry Tino...
07.03.2009 17:37:24
Bea
Ufff...
seid bitte nicht böse, aber das ist nun doch bei meinem Kenntnisstand ein bisl zu Hoch!
Werde mir deinen Code gut beiseite legen und hoffen, das ich in irgendwann einmal versteh
und entsprechend umsetzten kann.
Danke für deine Mühe
Gruß
Bea
AW: Sorry Tino...
07.03.2009 17:48:12
Tino
Hallo,
ich versuche es nochmal, vielleicht auch besser zu erklären.
Also Du erstellst Deine Datei an einem bestimmten Rechner, der hat eine Auflösung.
Diese Auflösung gibst Du in den Zeilen mit Const entsprechend an.
Diese Werte entsprechen 100%
Private Const LVertikal As Long = 1050
Private Const LHorizontale As Long = 1680
Nun gibst Du die Datei einem Kollegen, dieser hat eine ganz andere Bildschirmauflösung.
Nun wird gerechnet 100% / Originalauflösung * neue Auflösung ergibt x%
Den kleinsten davon nehmen wir und stellen den Zoom danach ein.
Hier der Code mit verbesserter Rechtschreibung, vielleicht hilft es ja. ;-)
kommt als Code in DieseArbeitsmappe 
Option Explicit 
'hier die Vertikale u. Horizontale Auflösung angeben, 
'wenn die Datei erstellt wird 
Private Const LVertikal As Long = 1050 
Private Const LHorizontale As Long = 1680 
 
Private Sub Workbook_Open() 
 Dim FaktorV As Double, FaktorH As Double 
' If ThisWorkbook.ActiveSheet.Name = "Tab1" Or ThisWorkbook.ActiveSheet.Name = "Tab2" Then 
    FaktorV = 100 / LVertikal * ScreenResolution(1) 
    FaktorH = 100 / LHorizontale * ScreenResolution(0) 
    ActiveWindow.Zoom = Application.WorksheetFunction.Min(FaktorV, FaktorH) 
' End If 
End Sub 
 
Private Sub Workbook_SheetActivate(ByVal Sh As Object) 
 Dim FaktorV As Double, FaktorH As Double 
  
' If Sh.Name = "Tab1" Or Sh.Name = "Tab2" Then 
    FaktorV = 100 / LVertikal * ScreenResolution(1) 
    FaktorH = 100 / LHorizontale * ScreenResolution(0) 
    ActiveWindow.Zoom = Application.WorksheetFunction.Min(FaktorV, FaktorH) 
' End If 
 
End Sub

Modul Modul1 

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long 
 
Function ScreenResolution(LIndex As Long) 
  ScreenResolution = GetSystemMetrics(LIndex) 
End Function


Gruß Tino

Anzeige
AW: Sorry Tino...
07.03.2009 18:40:25
Bea
oK. ich versuche es noch einmal.
Mit deinem Code werden meine bisherigen Einstellungen vom Zoomfaktor auf 100% zurückgesetzt.
Bisherige Einstellungen bei einer Auflösung 1280x1024:
Gesamte Arbeitsmappe Zoomfaktor 74%, bis auf Tab1 und Tab9. Bei diesen beiden Blättern habe ich jeweils einen Bereich definiert.
Für Tabelle1
Range("A1:R46").Select
ActiveWindow.Zoom = True
entspricht Zoomfaktor 85%
Für Tabelle9
Range("A1:R46").Select
ActiveWindow.Zoom = True
entspricht Zoomfaktor 103%
Bekomme es einfach nicht in Deinem Code angepaßt :-(
Bin aber an dieser Stelle nicht auch nicht enttäuscht, wenn Du nicht weiter machen möchtest.
Gruß
Bea
Anzeige
AW: Sorry Tino...
07.03.2009 18:48:33
Bea
Hatte die Bereiche falsch angegeben. Hier die richtigen.
Zoomfaktor stimmt aber
Tabelle1
A1:S50
Tabelle9
A1:O38
Gruß
Bea
AW: Sorry Tino...
07.03.2009 19:17:30
Tino
Hallo,
wenn Du mit unterschiedlichen Faktoren arbeitest, müssen wir dies im Code auch berücksichtigen.
Also nehmen wir den Wert den Deine Tabelle haben muss und verwenden diesen zur Berechnung.
kommt als Code in DieseArbeitsmappe 
Option Explicit 
'hier die Vertikale u. Horizontale Auflösung angeben, 
'wenn die Datei erstellt wird 
Private Const LVertikal As Long = 1050 
Private Const LHorizontale As Long = 1680 
 
'hier die Werte angeben die benötigt werden. 
Private Const LZoomTab1 As Long = 85  'Zoom Tabelle1 
Private Const LZoomTab2 As Long = 103 'Zoom Tabelle9 
  
Private Sub Workbook_Open() 
 Dim FaktorV As Double, FaktorH As Double 
 Dim FZoom As Long 
  
    With ThisWorkbook.ActiveSheet 
        If .Name = "Tabelle1" Or .Name = "Tabelle9" Then 
           FZoom = IIf(.Name = "Tabelle1", LZoomTab1, LZoomTab2) 
           FaktorV = FZoom / LVertikal * ScreenResolution(1) 
           FaktorH = FZoom / LHorizontale * ScreenResolution(0) 
           ActiveWindow.Zoom = Application.WorksheetFunction.Min(FaktorV, FaktorH) 
        End If 
    End With 
End Sub 
  
Private Sub Workbook_SheetActivate(ByVal Sh As Object) 
 Dim FaktorV As Double, FaktorH As Double 
 Dim FZoom As Long 
  With Sh 
        If .Name = "Tabelle1" Or .Name = "Tabelle9" Then 
           FZoom = IIf(.Name = "Tabelle1", LZoomTab1, LZoomTab2) 
           FaktorV = FZoom / LVertikal * ScreenResolution(1) 
           FaktorH = FZoom / LHorizontale * ScreenResolution(0) 
           ActiveWindow.Zoom = Application.WorksheetFunction.Min(FaktorV, FaktorH) 
        End If 
  End With 
End Sub

Modul Modul1 

Option Explicit 
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long 
  
Function ScreenResolution(LIndex As Long) 
  ScreenResolution = GetSystemMetrics(LIndex) 
End Function


Gruß Tino

@Tino Ein großes...
07.03.2009 19:46:28
Bea
...Lob für Dich.
Vielen Dank für Deine Ausdauer, Geduld und Bereitschaft dieses(mein) Problem zu lösen.
Es hat endlich geklappt, hab es schon auf zwei weiteren Rechner ausprobiert. Einwandfrei.
Daaaaaaanke
Bea
sowas hört man doch gern, super. :-) oT.
07.03.2009 19:49:23
Tino
AW: ich würde es eventuell...
07.03.2009 17:24:57
Nepumuk
Hi,
Horizo ~ abgrenzen natal ~ die Geburt betreffend passt doch, ist wieder mal ne grenzwertig schwere Geburt. :-)
Gruß
Nepumuk
genau witzig. ;-)) oT.
07.03.2009 17:29:27
Tino
Interessante Diskussion, aber
07.03.2009 18:01:44
Renee
ich würde das gaaaaanz anderst lösen.
Ich würd das Zoom immer auf 100% lassen und einfach die Bilder auf die Windows-Grösse skalieren ;-))
Was passiert denn, wenn das Excel-Fenster verkleinert wird ?
GreetZ Renée
Gute Frage?
07.03.2009 18:16:37
Tino
Hallo,
aber ich würde eher zur maximierten Datei tendieren,
Wenn der Anwender die nicht richtig erkennt wird er sie sowieso maximieren.
Aber er kann nur soweit maximieren wie es seine Auflösung zulässt.
Gruß Tino

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige