Ekran çözünürlüğünü sayfalara göre otomatik ayarlama

[klop01]

Değerli arkadaşlar,
Ekteki belgede açıklamasını yaptığım konuda yardıma ihtiyacım var.
Konu kısaca şöyle: Bir excel sayfasındaki sayfaların ekran çözünürlüğüne göre istenilen yakınlaştırma oranı ile açılması konusu.

http://s7.dosya.tc/server5/v7xg2x/ekran_cozunurlugu.rar.html

DOSYADAKİ KODLAR:
Bu Çalışma Sayfasında

Private Sub Workbook_Open()
ekrancozunurlugu
End Sub

Modülde

Option Explicit
Type RECT
x1 As Long
y1 As Long
x2 As Long
y2 As Long
End Type

#If VBA7 And Win64 Then
Declare PtrSafe Function GetDesktopWindow Lib "User32" () As Long
Declare PtrSafe Function GetWindowRect Lib "User32" (ByVal hWnd As Long, rectangle As RECT) As Long
#Else
Declare Function GetDesktopWindow Lib "User32" () As Long
Declare Function GetWindowRect Lib "User32" (ByVal hWnd As Long, rectangle As RECT) As Long
#End If


Function ekrancozunurlugu() As String
Dim R As RECT
Dim hWnd As Long
Dim RetVal As Long
hWnd = GetDesktopWindow()
RetVal = GetWindowRect(hWnd, R)
ekrancozunurlugu = (R.x2 - R.x1) & "x" & (R.y2 - R.y1)
If ekrancozunurlugu = "3840x2160" Then ActiveWindow.Zoom = 330
If ekrancozunurlugu = "3440x1440" Then ActiveWindow.Zoom = 276
If ekrancozunurlugu = "2560x1440" Then ActiveWindow.Zoom = 216
If ekrancozunurlugu = "2560x1080" Then ActiveWindow.Zoom = 216
If ekrancozunurlugu = "1920x1080" Then ActiveWindow.Zoom = 169
If ekrancozunurlugu = "1680x1050" Then ActiveWindow.Zoom = 146
If ekrancozunurlugu = "1600x1200" Then ActiveWindow.Zoom = 140
If ekrancozunurlugu = "1600x900" Then ActiveWindow.Zoom = 140
If ekrancozunurlugu = "1440x900" Then ActiveWindow.Zoom = 126
If ekrancozunurlugu = "1400x1050" Then ActiveWindow.Zoom = 122
If ekrancozunurlugu = "1366x768" Then ActiveWindow.Zoom = 119
If ekrancozunurlugu = "1360x768" Then ActiveWindow.Zoom = 119
If ekrancozunurlugu = "1280x1024" Then ActiveWindow.Zoom = 112
If ekrancozunurlugu = "1280x960" Then ActiveWindow.Zoom = 112
If ekrancozunurlugu = "1280x800" Then ActiveWindow.Zoom = 112
If ekrancozunurlugu = "1280x768" Then ActiveWindow.Zoom = 112
If ekrancozunurlugu = "1280x720" Then ActiveWindow.Zoom = 112
If ekrancozunurlugu = "1280x600" Then ActiveWindow.Zoom = 112
If ekrancozunurlugu = "1152x864" Then ActiveWindow.Zoom = 101
If ekrancozunurlugu = "1024x768" Then ActiveWindow.Zoom = 90
If ekrancozunurlugu = "800x600" Then ActiveWindow.Zoom = 71
End Function

 

[Zeki Gürsoy]

Açılışta sayfaları teker teker aktif yaparak zom kodunu çalıştırın. Örnek:

Sub Test()
    Dim sh As Worksheet, sh2 As Worksheet
    
    Set sh2 = ActiveSheet
    
    Application.ScreenUpdating = False
    
    For Each sh In ThisWorkbook.Worksheets
        sh.Activate
        ThisWorkbook.Windows(1).Zoom = 120
    Next
    
    sh2.Activate
    
    Application.ScreenUpdating = False
    
End Sub

.

 

[klop01]

Zeki Hoca'm,
Bu kodları nere yazmalıyım?
"Açılışta sayfaları teker teker aktif yaparak zom kodunu çalıştırın." derken bir butona mı bağlanmalı?

Birinci mesajımda verdiğim kodları internetten bulmuştum. Kodlama konusunda bilgim pek yok.
Konuyu tam olarak anlayamadım.

 

[Zeki Gürsoy]

"Workbook_Open" olayını değiştirerek şöyle kullanabilirsiniz mesela...

Private Sub Workbook_Open()
    Dim sh As Worksheet, sh2 As Worksheet
    
    Set sh2 = ActiveSheet
    
    Application.ScreenUpdating = False
    
    For Each sh In ThisWorkbook.Worksheets
        sh.Activate
        [COLOR=Blue][B]ekrancozunurlugu[/B][/COLOR]
    Next
    
    sh2.Activate
    
    Application.ScreenUpdating = False
    
End Sub

.

 

[klop01]

Son kodla beraber tüm sayfalar ekran çözünürlüğüne göre açılabiliyor.
Ekteki belgedeki sorumda farklı birkaç türde sayfam var. Farklı yakınlaştırma oranlarında açılması gereken.
Tüm sayfalar aynı oranda değil
sayfa1, 2,, 3 aynı açılma oranı
sayfa4, 5 yukarıdakilerden faklı oran
sayfa 6, 7, 8 farklı oran gibi

Bu yapılabilir mi?

 

[Korhan Ayhan]

Merhaba,

Eklediğiniz dosyada düzenleme yaptım. Sizin sadece fonksiyonun içinde hangi ekran çözünürlüğünde hangi sayfa zoom ayarını kullanmak istiyorsanız onu belirtmeniz yeterli olacaktır.

 

[klop01]

Sayın Korhan AYHAN,
Çok teşekkür ederim; ellerinize, bilginize sağlık.
Emek verip uğraşmışsınız. İstediğim sonucu tam olarak alıyorum, sağ olunuz.

Dosyada şöyle bir şey oluyor.
İnternet'ten indirilen dosyalar korumalı görünümde geliyor. “Düzenlemeyi Etkinleştir” deyince dosyada aşağıdaki hata mesajı oluşuyor.
Hataya "TAMAM" denince dosyadaki kodlar çalışıyor. Bu durum sadece “Düzenlemeyi Etkinleştir” deyince oluyor. Korumalı görünümü kaldırınca dosya normal çalışıyor, hata vermiyor.
Benim monitörüm 1920x1080 çözünürlükte. Hata mesajı da sadece bu çözünürlük için gözüküyor.

Bu konuda bir şey yapabilir miyiz?

 

[Korhan Ayhan]

Merhaba,

Eklediğim dosyayı yeniden indirip denedim. Bende de dosya korumalı görünümde açılıyor. Uyarıları etkinleştirerek açtığımda bahsettiğiniz hata bende oluşmadı.

 

[klop01]

Cevabınız için tekrar teşekkürler.

Yarın bir okulda deneyeyim bakayım. Benim bilgisayarda veya ofiste mi bir şey var.

6. MESAJDAKİ DOSYAYA BAKAN ARKADAŞLAR HATA VERİP VERMEDİĞİNİ YAZABİLİRLERSE İYİ OLUR.

 

[tahsinanarat]

Sn. klop01, Ben denedim herhangi bir hata almadım, bilginize.

 

[klop01]

Sayın tahsinanarat,
Teşekkür ederim, sağ olun.