Tam ekran koduna ek yapılması

[potifar534]

Arkadaşlar forumdan bulduğum aşağıdaki kod excel çalışma kitabını tam ekran olarak açıyor. Bunu yaparken diğer çalışma kitaplarını etkilemiyor. Sadece kendi sayfalarını tam ekran açıyor. Buraya kadar sorun yok.

Bu kodun excel çalışma sayfasında bulunan "Dosya, Giriş, Ekle, Sayfa Düzeni" bölümünü kaldırmaması için bir düzenleme yapmanın imkanı var mı?

http://s7.dosya.tc/server4/3rlhgr/TAM_EKRAN.rar.html

Private Sub Workbook_Deactivate()
Application.DisplayFullScreen = False
End Sub
Private Sub Workbook_Open()
Application.DisplayFullScreen = True
Sheets("Kayıt Giriş").Select
Range("C1").Select
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayFullScreen = False
End Sub
Private Sub Workbook_Activate()
Application.DisplayFullScreen = True
End Sub

 

[Saban Sertkaya]

Private Sub Workbook_Open()
[COLOR="Red"]Application.WindowState = xlMaximized[/COLOR]
Sheets("Kayıt Giriş").Select
Range("c1").Select
End Sub


Private Sub Workbook_Activate()
[COLOR="red"]Application.WindowState = xlMaximized[/COLOR]
End Sub

 

[potifar534]

Teşekkür ederim.
İşi görüyor.
Aşağıdaki şekli de olursa mükemmel olurdu.

Dosya, ekle, veriye tıklayınca alt menüsünün görünmesi tıklanmayınca gözükmemesi.
Yazı tipi, font büyüklüğü, italik vb. yerler kastettiğim.

 

[Korhan Ayhan]

Alternatif;

BuÇalışmaKitabı bölümüne;

Private Sub Workbook_Deactivate()
    Application.DisplayFullScreen = False
    If Application.CommandBars("Ribbon").Height < 80 Then Application.SendKeys "^{F1}"
End Sub

Private Sub Workbook_Open()
    Tam_Ekran
End Sub

Private Sub Workbook_Activate()
    Application.WindowState = xlMaximized
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.DisplayFullScreen = False
    If Application.CommandBars("Ribbon").Height < 80 Then Application.SendKeys "^{F1}"
End Sub

Boş bir modüle;

Sub Tam_Ekran()
    Application.WindowState = xlMaximized
    If Application.CommandBars("Ribbon").Height > 80 Then Application.SendKeys "^{F1}"
    Sheets("Kayıt Giriş").Select
    Range("c1").Select
End Sub

 

[potifar534]

Korhan Bey,
Teşekkürler.

Verdiğiniz kodlar istenileni yaptı fakat bilgisayardaki tüm excel çalışma kitaplarını da etkiliyor. Onlarda da geçerli oluyor.
Sadece kodu yazdığımız çalışma kitabı için geçerli olsa iyi olacak.

 

[Korhan Ayhan]

Koda küçük eklemeler yaptım. Tekrar deneyiniz.

 

[potifar534]

Çok teşekkürler.
Sağ olun.

 

[potifar534]

Korhan Bey
Dün gece dikkat edememişim. Kod diğer excel dosyalarını da etkiliyor hâlâ.

Bir de kodu eklediğim çalışma kitabını kapatırken çarpıya basar basmaz klavyedeki Num Lock ışığı sönüp pasif hale geliyor.

Koddan mı bilemiyorum ama birkaç kez gözlemledim çarpıya basar basmaz ışık sönüyor.

Kodu gözden geçirmeniz mümkün olursa cevabınızı rica ediyorum.

Çalışma kitabına kodların eklenmiş hali:
http://s7.dosya.tc/server4/gi088v/tam_ekran.zip.html

 

[Saban Sertkaya]

Geçenlerde başka bir üyeye yazmıştık. Revize ederek kullanabilirsiniz belki. Ek olarak yazayım dedim.

Private Sub Workbook_Open()
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)" 'Ribbon Menüyü Gizle
Application.WindowState = xlNormal 'Uygulamayı normal modda aç
Application.Left = 100 'Soldan
Application.Top = 50 'Üstten
Application.Width = 600 'Genişlik
Application.Height = 300 'Yükseklik
End Sub


Private Sub Workbook_Beforeclose(cancel As Boolean)
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
End Sub

 

[Korhan Ayhan]

Şimdi laptobumda denedim. Bahsettiğiniz sorunlar bende olmadı.

Belki masaüstü bilgisayarlarda bu sorun oluyordur.