Sayfa koruması ve ekran çözünürlüğü hk

[Bekci_32]

İlk önce teşekkür ederek başlamak istiyorum.Çünkü ekte göndermiş olduğum xls yi sayın Korhan hocam düzenleyerek göndermişti.Sağolsun.Ancak insan birşeyler yapmaya başlayınca ister istemez eksiklikleri görüyor ve ihtiyaç duyuyor.Ben yine bu uygulama üzerinde bir kaç yardım almak istiyorum.Kitap içerisine not düştüm.Eğer ilgilenirseniz sevinirim.Bilgilerinizden faydalanmak gerçekten hoşuma gidiyor ve birşeyler öğrendiğim ve sayenizde yaptığım için çok mutlu oluyorum.Saygılar

 

[leumruk]

Dosyanız boş.

 

[Bekci_32]

hocam sıkıştırma başarısız olmuş kusura bakmayın tekrar gönderdim

 

[Bekci_32]

hocam sizden bir ricam daha olacak Text Box da iki yana yasla kodunu yazarsanız sevinirim

 

[leumruk]

Sub TEMİZLE()
ActiveSheet.Unprotect 12345
    Application.ScreenUpdating = False
    Range("J4,F6,E8:K10,E11:G11,H11:I11,E12:K29,G32:H33,H31,J32:K32,J33:K33").ClearContents
    Application.ScreenUpdating = True
ActiveSheet.Protect 12345
End Sub

Sayfa korumasıyla ilgili kod. Siz yukarıdaki numaralar yerine kendi şifrenizi yazınız. 1. kod korumayı açar, 2. kod yeniden devreye sokar.
Sayfalarınız gizli olduğu için silme kodu hakkında fikrim yok.

 

[Bekci_32]

hocam Teşekkürler.

 

[Bekci_32]

Konu hakkında değişik fikirleri olanlar varsa ve ayrıca TextBox ta iki yana yasla kodunu bilen varsa yardım etsin.

 

[bletchley]

Dosyayi incelemek icin actiktan sonra farkettim ki, herhangi bir excel dosyasini acarken de menu cubugu gorunmuyor...Nasil eski haline getirebilirim ?

 

[Bekci_32]

menü düzelt fonksiyonunu kullanabilirsiniz

 

[bletchley]

menü düzelt fonksiyonunu kullanabilirsiniz

Rica etsem, daha aciklayici olabilir misin ?

 

[leumruk]

Dosya üzerinde "menü düzelt" butonu var. O butona tıkladığınızda menü düzeliyor.

Syn. bekçi, sayfaları görünür hale getirip dosyayı yeniden eklerseniz, daha kolay yardım alabilirsiniz. Sanırım sayfaları kodlarla gizlemişsiniz.

 

[Bekci_32]

Açmış olduğunuz uygulamada menü düzelt butonu var onu tıklamanız yeterli.

 

[Bekci_32]

farkında değilim düzeltip tekrar göndereyim TŞK

 

[Bekci_32]

Sayfaların görünmediği söylendiği için tekrar düzelterek gönderdim.Sayfa içerisine yazdığım konular ile ilgili yardım eden olursa sevinirim.Özellikle ekran çözünürlüğü ve veri deposundan kişi kaydının komple silinmesi ile ilgili.Teşekkürler.İlginize.

 

[Bekci_32]

İlk gönderdiğim dosya düzeltilmiş dosyadır.Üstadlar ilgilenirseniz sevinirim.

 

[leumruk]

Sayfaların görünmediği söylendiği için tekrar düzelterek gönderdim.Sayfa içerisine yazdığım konular ile ilgili yardım eden olursa sevinirim.Özellikle ekran çözünürlüğü ve veri deposundan kişi kaydının komple silinmesi ile ilgili.Teşekkürler.İlginize.

Sub Sil()
Sheets("Veri Deposu").Range(Cells(2, "IV"), Cells(Cells(65536, "A").End(xlUp).Row, "A")).Delete
End Sub

Bu verdiğim silme kodu... Ekran çözünürlüğü hakkında fikrim yok.

 

[Bekci_32]

lemruk arkadaşım İlgine teşekkürler sağolasın.Bu ekran çözünürlüğü ile ilgili bir uygulama görmüştüm.Ama uygulamada VB şifresi kullanılmış.Açamadım.Çok hoş bir uygulama olmuş.Aslında yapılan her uygulamalarda kullanılabilir.Nedenine gelince daha öncede açıklamıştım bu yapılan uygulamalar değişik pc lerde kullanıldığı için pclerin ekranları değişik olabiliyor ekran inç lerine göre sayfa tam olarak görünmüyor ve sağ tarafı mutlaka kesik oluyor veya sayfa dışına çıkıyor.Umarım anlatabilmişimdir.Saygılar

 

[leumruk]

Syn. Bekci 32,
Site içi arama yapmanızı tavsiye ederim. Konuyla ilgili güzel örnekler var. Biri mutlaka işinize yarayacaktır. "Ekran çözünürlüğü" ismiyle aratabilirsiniz.

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyada açılışta ekran çözünürlüğü kontrol edilerek eğer belirlenmiş olan ekran çözünürlüğünden farklı bir çözünürlük kullanılıyorsa uyarı mesajı verip çözünürlük ayarı yapılmaktadır. İncelermisiniz.

Kullanılan kod; (Alıntıdır)

Option Explicit
 
Const CCDEVICENAME = 32
Const CCFORMNAME = 32
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const CDS_TEST = &H4
 
Private Type DISPLAY_DEVICE
    cb As Long
    DeviceName As String * 32
    DeviceString As String * 128
    StateFlags As Long
    DeviceID As String * 128
    DeviceKey As String * 128
End Type
 
Private Type DEVMODE
    dmDeviceName As String * CCDEVICENAME
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
    dmOrientation As Integer
    dmPaperSize As Integer
    dmPaperLength As Integer
    dmPaperWidth As Integer
    dmScale As Integer
    dmCopies As Integer
    dmDefaultSource As Integer
    dmPrintQuality As Integer
    dmColor As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer
    dmFormName As String * CCFORMNAME
    dmUnusedPadding As Integer
    dmBitsPerPel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
    dmICMMethod As Long 'NT 4.0
    dmICMIntent As Long 'NT 4.0
    dmMediaType As Long 'NT 4.0
    dmDitherType As Long 'NT 4.0
    dmReserved1 As Long 'NT 4.0
    dmReserved2 As Long 'NT 4.0
    dmPanningWidth As Long 'Win2000
    dmPanningHeight As Long 'Win2000
End Type
 
Private Declare Function ChangeDisplaySettingsEx Lib "user32" Alias "ChangeDisplaySettingsExA" (lpszDeviceName As Any, lpDevMode As Any, ByVal hWnd As Long, ByVal dwFlags As Long, lParam As Any) As Long
Private Declare Function EnumDisplayDevices Lib "user32" Alias "EnumDisplayDevicesA" (Unused As Any, ByVal iDevNum As Long, lpDisplayDevice As DISPLAY_DEVICE, ByVal dwFlags As Long) As Boolean
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
 
Dim OldX As Long, OldY As Long, T As Long
 
Sub AUTO_OPEN()
    Dim DD As DISPLAY_DEVICE, DevM As DEVMODE
    Dim mesaj As String
    DD.cb = Len(DD)
    OldX = GetSystemMetrics(0)
    OldY = GetSystemMetrics(1)
    'İlk ayarları Belirliyoruz
    DevM.dmSize = Len(DevM)
    'Dikey ve Yatay Rezolasyonu Değiştiriyoruz
    DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
    If OldX <> 1280 Then
    mesaj = MsgBox("Programın sağlıklı çalışabilmesi için görüntü ayarlarınızın 1280 x 1024 çözünürlükte olması gerekmektedir." & Chr(10) & "Aksi halde program çalışmayacaktır.Şimdi ayarlamak ister misiniz?", vbYesNo)
    If mesaj = vbYes Then
    DevM.dmPelsWidth = 1280
    DevM.dmPelsHeight = 1024
    Call ChangeDisplaySettingsEx(ByVal 0&, DevM, ByVal 0&, CDS_TEST, ByVal 0&)
    Else
    End
    End If
    End If
End Sub

 

[Bekci_32]

Sayın Korhan bey göndermiş olduğunuz uygulamada sadece 1024x1280 ekran çözünürlüğü var.Buda güzel ama benim söylemek istediğim ilk sayfaya bir buton koyarak değişik ekran çözünürlüklerini User Form ile bize sunması ve istediğimiz ekran çözünürlüğünü seçebilmemiz.Çok Teşekkürler ilginize Saygılar