Macrolar aktif edilmezse, gizlenen sayfalar görünmesin

sozsy · 14 Mart 2024

Merhaba,
Aşağıda belirtmiş olduğum şekilde çalışacak vba kodlarına ihtiyacım var.
Buradaki amaç çalışma kitabındaki macrolarin aktif edilmeden kullanılmaması olacak.
Sayfa1 e eklemiş olduğum notu görecek ve macrolari aktif etmek zorunda kalacak, eğer Macrolar aktif edilmezse diğer sayfalar görünmeyecek ve kayıt yapılamayacak.
Şimdiden teşekkür ederim.

Çalışma kitabını açtığım zaman,
Macro güvenlik ayarları enable all macros olarak aktif ise, yada Macrolar aktif edilirse.
Otomatik olarak Sayfa1 i gizle.
Sayfa2, sayfa3, sayfa4, sayfa5, sayfa6, sayfa7 yi aç.

Çalışma kitabı kapatılmak istendiğinde,
Sayfa1 i aç.
Sayfa2, sayfa3, sayfa4, sayfa5, sayfa6, sayfa7 yi gizle.
Yapılan değişiklikleri kaydet ve excelden çıkış yap.

Çalışma kitabında bulunan,
Sayfa2, sayfa3, sayfa4, sayfa5, sayfa6, sayfa7 de
F ile NG sütunları arasında
i harfinin en fazla 2 kere yazılmasına izin ver.
Eğer 2 den fazla yazılırsa, bu tarih için izin kaydı yapılamaz uyarısi ver ve fazla yazılan i harfini sil.

Çalışma kitabında bulunan,
Sayfa2, sayfa3, sayfa4, sayfa5, sayfa6, sayfa7 de
F ile NG sütunları arasında
, i harfi dışında farklı bir karaktere izin verme.
Eğer farklı bir karakter yazılırsa, lütfen i harfi ile kayıt oluşturunuz uyarısı ver ve hatalı yazılan harfi sil.

Çalışma kitabında bulunan,
Sayfa2, sayfa3, sayfa4, sayfa5, sayfa6, sayfa7 de
F ile NG sütunları arasında kopyala yapıştır işlemlerinin yapılmasını engelle.

DoğanD · 14 Mart 2024

Merhaba,

Aşağıdaki kodları dener misiniz?

Sayfa2-7 kod kısmına;

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column < 6 Or Target.Column > 371 Or Target.Value = "" Then Exit Sub
If Target.Value <> "i" Then
MsgBox "Lütfen 'i' harfi ile kayıt oluşturun!", vbInformation, ""
Target.Value = ""
Exit Sub
Else
If WorksheetFunction.CountIf(Range("F" & Target.Row & ":NG" & Target.Row), "i") > 2 Then
MsgBox "Bu tarih için izin kaydı yapılamaz!", vbCritical, ""
Target.Value = ""
End If
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column < 6 Or Target.Column > 371 Then Exit Sub
Application.CutCopyMode = False
End Sub

Çalışma Kitabı kod kısmına;

Kod:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sayfa1.Visible = xlSheetVisible
Sayfa2.Visible = xlSheetVeryHidden
Sayfa3.Visible = xlSheetVeryHidden
Sayfa4.Visible = xlSheetVeryHidden
Sayfa5.Visible = xlSheetVeryHidden
Sayfa6.Visible = xlSheetVeryHidden
Sayfa7.Visible = xlSheetVeryHidden
ThisWorkbook.Save
End Sub
Private Sub Workbook_Open()
Sayfa2.Visible = xlSheetVisible
Sayfa3.Visible = xlSheetVisible
Sayfa4.Visible = xlSheetVisible
Sayfa5.Visible = xlSheetVisible
Sayfa6.Visible = xlSheetVisible
Sayfa7.Visible = xlSheetVisible
Sayfa1.Visible = xlSheetVeryHidden
End Sub

sozsy · 14 Mart 2024

Macrolari aktif ettiğimde
Run-time error '424':
Object required
Hatası alıyorum.

Debug dediğimde,
Private Sub Workbook_Open ()
Sayfa2. Visible =xlSheetVisible
Satiri sarı boyalı görünüyor.

sozsy · 14 Mart 2024

sozsy' Alıntı:
Macrolari aktif ettiğimde
Run-time error '424':
Object required
Hatası alıyorum.

Debug dediğimde,
Private Sub Workbook_Open ()
Sayfa2. Visible =xlSheetVisible
Satiri sarı boyalı görünüyor.

Ayrıca i harfini her sütunda 2 defadan fazla yazamamam gerekli, bu macro satırlar için değil sütunlar da kullanılacak. Yani her sütunda max 2 defa i yazılabilir

Muzaffer Ali · 14 Mart 2024

Merhaba.

Aşağıdaki kodların tamamını "BuÇalışmaKitabı" adlı kod sayfasına kopyalayın.

Kod:

Public Sayfalar As Variant

Sub xSayfalar()
    Sayfalar = Array(Sayfa2, Sayfa3, Sayfa4, Sayfa5, Sayfa6, Sayfa7)
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim Bak As Byte
    Sayfa1.Visible = xlSheetVisible
    If IsEmpty(Sayfalar) Then xSayfalar
    For Each Bak In Sayfalar
        Bak.Visible = xlSheetVeryHidden
    Next
    ThisWorkbook.Save
End Sub
Private Sub Workbook_Open()
    Dim Bak As Byte
    xSayfalar
    For Bak = 0 To UBound(Sayfalar)
        Sayfalar(Bak).Visible = xlSheetVisible
    Next
    Sayfa1.Visible = xlSheetVeryHidden
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Bak As Byte
    If IsEmpty(Sayfalar) Then xSayfalar
    For Bak = 0 To UBound(Sayfalar)
        If Sh.Name = Sayfalar(Bak).Name Then
            If Not Intersect(Target, Range("F:NG")) Is Nothing Then
                If Target.Text <> "i" And Target.Text <> "" Then
                    MsgBox "Lütfen i harfi ile kayıt oluşturunuz.", vbExclamation
                    Application.EnableEvents = False
                    Target.Value = ""
                    Target.Select
                    Application.EnableEvents = True
                    Exit Sub
                ElseIf WorksheetFunction.CountIf(Range("F" & Target.Row & ":NG" & Target.Row), "i") > 2 Then
                    MsgBox "Bir satırda sadewce iki tane 'i' harfi olabilir.", vbExclamation
                    Application.EnableEvents = False
                    Target.Value = ""
                    Target.Select
                    Application.EnableEvents = True
                    Exit Sub
                End If
            End If
            Exit For
        End If
    Next
End Sub

Private Sub Workbook_Deactivate()
    Dim Copy As CommandBarButton
    Application.OnKey "^c"
    Application.OnKey "^v"
    For Each Copy In Application.CommandBars.FindControls(ID:=19)
        Copy.Enabled = True
    Next Copy
End Sub

Private Sub Workbook_activate()
    Dim Copy As CommandBarButton
    Application.OnKey "^c", ""
    Application.OnKey "^v", ""
    For Each Copy In Application.CommandBars.FindControls(ID:=19)
        Copy.Enabled = False
    Next Copy
End Sub

sozsy · 14 Mart 2024

Muzaffer bey merhaba,
Şuan sistem çok güzel çalışıyor emeğinize sağlık,fakat tek bir yerde problem ile karşılaştım.
"i" harfi 2 den fazla yazılırsa kısmı satırlarda çalışıyor, bu kodun F ile NG sütunları arasında çalışması gerekli.
Yani kısaca açıklayacak olursam, F sütununa 2 den fazla "i" yazılmasın, G sütununa 2 den fazla "i" yazılmasın, H sütununa 2 den fazla "i" yazılmasın.
Bu macro NG sütununa kadar bu şekilde çalışmalı.
İlginiz için tekrar teşekkür ederim.

Muzaffer Ali · 14 Mart 2024

Aşağıdaki satırı silin

Kod:

ElseIf WorksheetFunction.CountIf(Range("F" & Target.Row & ":NG" & Target.Row), "i") > 2 Then

yerine aşağıdakini ekleyin.

Kod:

ElseIf WorksheetFunction.CountIf(Target.EntireColumn, "i") > 2 Then

sozsy · 14 Mart 2024

Muzaffer bey sistem sorunsuz çalışıyor, emeğinize sağlık.
Teşekkür ederim,,,

sozsy · 15 Mart 2024

sozsy' Alıntı:
Muzaffer bey sistem sorunsuz çalışıyor, emeğinize sağlık.
Teşekkür ederim,,,

Muzaffer bey merhaba,
Excel 2013 TR de sistem sorunsuz çalışıyor fakat Excel 2019 İngilizce de aşağıdaki hatayı almaktayım.
Sayfalar(Bak).Visible = xlSheetVisible

Güncelleyebilir misiniz?

Muzaffer Ali · 16 Mart 2024

Buradaki tüm sayfa isimlerini aynen aşağıdaki gibi yapın. Ben iki tane yaptım siz hepsini böyle gibi yapın.

Kod:

Sub xSayfalar()
    Sayfalar = Array(Worksheets("Sayfa2"), Worksheets("Sayfa3"))
End Sub

Yine de düzelmezse hata mesajını da iletin.

sozsy · 16 Mart 2024

Muzaffer Ali' Alıntı:
Buradaki tüm sayfa isimlerini aynen aşağıdaki gibi yapın. Ben iki tane yaptım siz hepsini böyle gibi yapın.

Kod:

Sub xSayfalar() Sayfalar = Array(Worksheets("Sayfa2"), Worksheets("Sayfa3")) End Sub

Yine de düzelmezse hata mesajını da iletin.

Run Time Error '424'
Object required
Hatası alıyorum
Debug dediğimde ise
Private Sub Workbook_BeforeClose (Can el As Boolean)
Sayfa1. Visible = xlsheetVisible
Bu satır sarı boyali görünüyor

Muzaffer Ali · 16 Mart 2024

Sayfa1.Visible = xlsheetVisible silin yerine Sayfa1.Visible = true kopyalayıp deneyin.

Muzaffer Ali · 16 Mart 2024

Yine de olmazsa dosyanızı ekleyin kontrol edeyim.
Dosyanızı dosya.tc gibi bir paylaşım sitesine ekleyebilirsiniz

sozsy · 16 Mart 2024

sozsy' Alıntı:
Run Time Error '424'
Object required
Hatası alıyorum
Debug dediğimde ise
Private Sub Workbook_BeforeClose (Can el As Boolean)
Sayfa1. Visible = xlsheetVisible
Bu satır sarı boyali görünüyor

Exceli kapatıp açtığımda ise,
Run time error '9'
Subscript out of Range
Hatası geliyor
Debug dediğimde ise,
Sayfalar, Array(Worksheets("Sayfa2", Worksheets("Sayfa3"...)) bu kısım sarı boyalı görünüyor

Muzaffer Ali · 16 Mart 2024

Dosyanızı görmeden bir şey diyemeyeceğim.

sozsy · 16 Mart 2024

Muzaffer Ali' Alıntı:
Yine de olmazsa dosyanızı ekleyin kontrol edeyim.
Dosyanızı dosya.tc gibi bir paylaşım sitesine ekleyebilirsiniz

Dosyam şirkette olduğu için upload yapamıyorum malesef,
Sayfa1. Visible = True
Bu kısımda sarı boyandı

sozsy · 16 Mart 2024

sozsy' Alıntı:
Dosyam şirkette olduğu için upload yapamıyorum malesef,
Sayfa1. Visible = True
Bu kısımda sarı boyandı

Muzaffer bey, boş bir 7 sayfalık excelde deneme imkanınız varsa çok sevinirim. Excel 2019 ingilizce kullanıyorum.

Muzaffer Ali · 16 Mart 2024

Deneyin.

Kod:

Public Sayfalar As Variant

Sub xSayfalar()
    Sayfalar = Array(Worksheets("Sayfa2"), Worksheets("Sayfa3"), Worksheets("Sayfa4"), Worksheets("Sayfa5"), Worksheets("Sayfa6"), Worksheets("Sayfa7"))
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim Bak As Variant
    Worksheets("Sayfa1").Visible = xlSheetVisible
    If IsEmpty(Sayfalar) Then xSayfalar
    For Each Bak In Sayfalar
        Bak.Visible = xlSheetVeryHidden
    Next
    ThisWorkbook.Save
End Sub
Private Sub Workbook_Open()
    Dim Bak As Byte
    xSayfalar
    For Bak = 0 To UBound(Sayfalar)
        Sayfalar(Bak).Visible = xlSheetVisible
    Next
    Worksheets("Sayfa1").Visible = xlSheetVisible
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Bak As Byte
    If IsEmpty(Sayfalar) Then xSayfalar
    For Bak = 0 To UBound(Sayfalar)
        If Sh.Name = Sayfalar(Bak).Name Then
            If Not Intersect(Target, Range("F:NG")) Is Nothing Then
                If Target.Text <> "i" And Target.Text <> "" Then
                    MsgBox "Lütfen i harfi ile kayıt oluşturunuz.", vbExclamation
                    Application.EnableEvents = False
                    Target.Value = ""
                    Target.Select
                    Application.EnableEvents = True
                    Exit Sub
                ElseIf WorksheetFunction.CountIf(Target.EntireColumn, "i") > 2 Then
                    MsgBox "Bir satırda sadewce iki tane 'i' harfi olabilir.", vbExclamation
                    Application.EnableEvents = False
                    Target.Value = ""
                    Target.Select
                    Application.EnableEvents = True
                    Exit Sub
                End If
            End If
            Exit For
        End If
    Next
End Sub

Private Sub Workbook_Deactivate()
    Dim Copy As CommandBarButton
    Application.OnKey "^c"
    Application.OnKey "^v"
    For Each Copy In Application.CommandBars.FindControls(ID:=19)
        Copy.Enabled = True
    Next Copy
End Sub

Private Sub Workbook_activate()
    Dim Copy As CommandBarButton
    Application.OnKey "^c", ""
    Application.OnKey "^v", ""
    For Each Copy In Application.CommandBars.FindControls(ID:=19)
        Copy.Enabled = False
    Next Copy
End Sub

ÖmerBey · 16 Mart 2024

sozsy' Alıntı:
Sayfa1. Visible = True
Bu kısımda sarı boyandı
Excel 2019 ingilizce kullanıyorum.

Merhaba,
Buradaki Sayfa1 sekme adı değil, vba'daki sayfa ismi oluyor. Siz İngilizce kullandığınız için yeni oluşturduğunuz dosyada muhtemelen sayfa isimleri Sheet1, Sheet2 şeklinde oluşuyordur. Bu sebeple ilgili isim bulunmadığı için hata alıyorsunuz.
Sarıya boyanan satırdaki Sayfa1 ifadesini kendi oluşturduğunuz dosyanın visual basic düzenleyicisindeki sayfa ismiyle (muhtemelen Sheet1) değiştiriniz.

sozsy · 16 Mart 2024

Muzaffer Ali' Alıntı:

Deneyin.

Kod:

Public Sayfalar As Variant

Sub xSayfalar()
    Sayfalar = Array(Worksheets("Sayfa2"), Worksheets("Sayfa3"), Worksheets("Sayfa4"), Worksheets("Sayfa5"), Worksheets("Sayfa6"), Worksheets("Sayfa7"))
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim Bak As Variant
    Sayfa1.Visible = xlSheetVisible
    If IsEmpty(Sayfalar) Then xSayfalar
    For Each Bak In Sayfalar
        Bak.Visible = xlSheetVeryHidden
    Next
    ThisWorkbook.Save
End Sub
Private Sub Workbook_Open()
    Dim Bak As Byte
    xSayfalar
    For Bak = 0 To UBound(Sayfalar)
        Sayfalar(Bak).Visible = xlSheetVisible
    Next
    Sayfa1.Visible = xlSheetVeryHidden
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Bak As Byte
    If IsEmpty(Sayfalar) Then xSayfalar
    For Bak = 0 To UBound(Sayfalar)
        If Sh.Name = Sayfalar(Bak).Name Then
            If Not Intersect(Target, Range("F:NG")) Is Nothing Then
                If Target.Text <> "i" And Target.Text <> "" Then
                    MsgBox "Lütfen i harfi ile kayıt oluşturunuz.", vbExclamation
                    Application.EnableEvents = False
                    Target.Value = ""
                    Target.Select
                    Application.EnableEvents = True
                    Exit Sub
                ElseIf WorksheetFunction.CountIf(Target.EntireColumn, "i") > 2 Then
                    MsgBox "Bir satırda sadewce iki tane 'i' harfi olabilir.", vbExclamation
                    Application.EnableEvents = False
                    Target.Value = ""
                    Target.Select
                    Application.EnableEvents = True
                    Exit Sub
                End If
            End If
            Exit For
        End If
    Next
End Sub

Private Sub Workbook_Deactivate()
    Dim Copy As CommandBarButton
    Application.OnKey "^c"
    Application.OnKey "^v"
    For Each Copy In Application.CommandBars.FindControls(ID:=19)
        Copy.Enabled = True
    Next Copy
End Sub

Private Sub Workbook_activate()
    Dim Copy As CommandBarButton
    Application.OnKey "^c", ""
    Application.OnKey "^v", ""
    For Each Copy In Application.CommandBars.FindControls(ID:=19)
        Copy.Enabled = False
    Next Copy
End Sub

Aynı kısımda yine hata alıyorum
Sayfa1. Visible = xlSheetVisible

Macrolar aktif edilmezse, gizlenen sayfalar görünmesin

sozsy

DoğanD

sozsy

sozsy

Muzaffer Ali

Destek Ekibi

sozsy

Muzaffer Ali

Destek Ekibi

sozsy

sozsy

Muzaffer Ali

Destek Ekibi

sozsy

Muzaffer Ali

Destek Ekibi

Muzaffer Ali

Destek Ekibi

sozsy

Muzaffer Ali

Destek Ekibi

sozsy

sozsy

Muzaffer Ali

Destek Ekibi

ÖmerBey

Destek Ekibi

sozsy