Makro ile Dashboard raporunu açılışta tam ekran yapmak

[ascifci]

Arkadaşlar merhaba malum Excelde dashboard raporları hazırlıyoruz ve bunları başka başka bilgisayar ekranlarında görüntüleniyor.Çözünürlükleri farklı vs. Bunu açılışta hangi ekran ise ona uygun hale getirmek için bir kod vardı ama bir türlü hatırlayamıyorum.Yardımcı olabilirseniz sevinirim.

 

[tacettinsal]

Aşağıdaki gibi bir yapı kullanabilirsiniz.

Private Sub Workbook_Open()
Range("b1").Select
ActiveWindow.Zoom = 100
End Sub

 

[klop01]

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

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...

www.excel.web.tr

Yukarıdaki 6 numaralı iletideki dosya işinizi görecektir.
Şöyle bir durum var:
Bir bilgisayarın ölçek değeri (ekranın büyütülme oranı) %100, diğeri %125 ise sorun oluyor yine.
Bu durumu aşmak için de bir kodum vardı fakat yanımda olmayan bilgisayarımda kaldı.
Aceleniz yoksa 2 haftaya kadar gönderebilirim.

 

[ascifci]

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

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...

www.excel.web.tr

Yukarıdaki 6 numaralı iletideki dosya işinizi görecektir.
Şöyle bir durum var:
Bir bilgisayarın ölçek değeri (ekranın büyütülme oranı) %100, diğeri %125 ise sorun oluyor yine.
Bu durumu aşmak için de bir kodum vardı fakat yanımda olmayan bilgisayarımda kaldı.
Aceleniz yoksa 2 haftaya kadar gönderebilirim.

Çok iyi olur acelem yok. Size tekrar hatırlatırım. Bu arada belki bende bulursam paylaşırım.

 

[ascifci]

Şöyle birşey buldum
Range("A1:Q30").Select
ActiveWindow.Zoom = True

Tacettin bey sizin kodunuza benzer aslında iş görüyor.Basit

Aşağıdaki gibi bir yapı kullanabilirsiniz.

Private Sub Workbook_Open()
Range("b1").Select
ActiveWindow.Zoom = 100
End Sub

 

[klop01]

Sayın ascifci,
5. iletinizde yazdığınız kod basitçe ekranı ayarlıyor. Ben de kimi dosyalarımda kullanıyorum. Eğer siz sayfada görmek istediğiniz alanı sıfır hata ile (sağdan ve alttan hatasız yerleşim) almak istiyorsanız bu kod da işe yaramayabiliyor. Ekranı ayarlarken altta ve sağda yer yer ufak da olsa boşluklar kalabiliyor.

Yukarıdaki 3 numaralı iletimde bahsettiğim kodu aşağıya ekliyorum. Ben bu kodla sıfır hata ile istediğim görünümü ayarlayabildim.

Bu Çalışma Kitabı Bölümüne aşağıdaki kodu ekleyin:

Private Sub Workbook_Open()
'GetDpi
If GetDpi = 96 Then 'Ölçek: 100
'Buraya Ölçek: 100'e göre ayarlanmış kodun adı yazılacak.
ElseIf GetDpi = 120 Then 'Ölçek: 125
'Buraya Ölçek: 125'e göre ayarlanmış kodun adı yazılacak.
ElseIf GetDpi = 144 Then 'Ölçek: 150
'Buraya Ölçek: 150'ye göre ayarlanmış kodun adı yazılacak.
ElseIf GetDpi = 168 Then 'Ölçek: 175
'Buraya Ölçek: 175'e göre ayarlanmış kodun adı yazılacak.
ElseIf GetDpi = 192 Then 'Ölçek: 200
'Buraya Ölçek: 200'e göre ayarlanmış kodun adı yazılacak.
End If
End Sub

Boş bir modüle aşağıdaki kodu ekleyin:

Option Explicit

Private Const LOGPIXELSX As Long = 88

#If VBA7 Then
    Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
    Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
    Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long
#Else
    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
#End If

Public Function GetDpi() As Long
    #If VBA7 Then
        Dim hdcScreen As LongPtr
    #Else
        Dim hdcScreen As Long
    #End If
    hdcScreen = GetDC(0)

    Dim iDPI As Long
    iDPI = -1

    If (hdcScreen) Then
        iDPI = GetDeviceCaps(hdcScreen, LOGPIXELSX)
        ReleaseDC 0, hdcScreen
    End If

    GetDpi = iDPI
End Function

Yukarıdaki kodlar Windows'un Ölçek (zoom) değerini algılamaya yarıyor. Bu kodları yukarıdaki 3 numaralı mesajımda adı geçen dosyadaki kod ile beraber kullanınca sonuç alınıyor.