• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

buton rengi

Katılım
1 Eylül 2005
Mesajlar
283
Excel Vers. ve Dili
microsoft office 2019
merhaba arkadaşlar
elimde aşağıdaki şekilde kod var(başka bir arkadaş yazdı)

Private Sub CommandButton2_Click()
Dim a As Integer
Dim ck As Workbook
For a = 1 To Workbooks.Count
If Workbooks(a).Name = "A.xlsx" Then
MsgBox "Dosya zaten açık.", vbCritical, "U Y A R I"
GoTo acik
End If
Next a
Workbooks.Open ("D:\A.xlsx")
acik:
Set ck = Workbooks("A.xlsx")
If Date >= ck.Sheets(1).Range("A2").Value - 30 Then
CommandButton2.BackColor = vbRed
MsgBox "A.xlsx adlı dosyanızdaki tarihe" & vbNewLine & "1 aydan daha az bir zaman kaldığı için" & vbNewLine & "komut butonunun rengi değişti.", vbInformation, "R E N K"
End If
End Sub

bu koda göre bir butona bastığımda başka bir çalışma kitabı açılıyor.ve orada tarihleri kontrol etmesi lazım.arkadaşım tek bir hücre için bu kodu uygulamış.bunu a1:m1000 aralığı için nasıl uygularız.ayrıca buton rengi burada a1:m1000 hücre aralığında tarih olarak 1 aydan daha az bir zaman kaldığı zaman kırmızı oluyor.bu tarihler düzeltildikten sonra eski rengine dönmesini istiyorum.
 
Kodu Ekteki Gibi Denermisiniz.

Kod:
Private Sub CommandButton2_Click()
Dim a As Integer
Dim ck As Workbook
For a = 1 To Workbooks.Count
    If Workbooks(a).Name = "A.xlsx" Then
        MsgBox "Dosya zaten açık.", vbCritical, "U Y A R I"
        GoTo acik
    End If
Next a
Workbooks.Open ("D:\A.xlsx")
acik:
Set ck = Workbooks("A.xlsx")
[B]If Date >= Worksheetfunction.Small(ck.Sheets(1).Range("A1:M1000"),1) - 30 Then[/B]
    CommandButton2.BackColor = vbRed
    MsgBox "A.xlsx adlı dosyanızdaki tarihe" & vbNewLine & "1 aydan daha az bir zaman kaldığı için" & vbNewLine & "komut butonunun rengi değişti.", vbInformation, "R E N K"
End If
End Sub
 
Kodu Ekteki Gibi Denermisiniz.

Kod:
Private Sub CommandButton2_Click()
Dim a As Integer
Dim ck As Workbook
For a = 1 To Workbooks.Count
    If Workbooks(a).Name = "A.xlsx" Then
        MsgBox "Dosya zaten açık.", vbCritical, "U Y A R I"
        GoTo acik
    End If
Next a
Workbooks.Open ("D:\A.xlsx")
acik:
Set ck = Workbooks("A.xlsx")
[B]If Date >= Worksheetfunction.Small(ck.Sheets(1).Range("A1:M1000"),1) - 30 Then[/B]
    CommandButton2.BackColor = vbRed
    MsgBox "A.xlsx adlı dosyanızdaki tarihe" & vbNewLine & "1 aydan daha az bir zaman kaldığı için" & vbNewLine & "komut butonunun rengi değişti.", vbInformation, "R E N K"
End If
End Sub

merhaba sayın Huseyinkis
kodu denedim olmadı.bütün tarihlere 1 aydan fazla olmasına rağmen buton rengi değişti
 
merhaba sayın Huseyinkis
kodu denedim olmadı.bütün tarihlere 1 aydan fazla olmasına rağmen buton rengi değişti

Kodun yanlış çalışma olasılığı çok dusuk.

A1:M1000 arasında bos hüre varmı?
A1:M1000 arasında tarih haricinde herhanbir sayı içeren bolum varmı?
birde =Küçük($A$1:$M$1000;1) formulunu N1 hücresine yapıştırıp çıkan sonuca bakarmısınız sonuç 40562 den kucuk bir sayı çıkmaması lazım.
 
Kodun yanlış çalışma olasılığı çok dusuk.

A1:M1000 arasında bos hüre varmı?
A1:M1000 arasında tarih haricinde herhanbir sayı içeren bolum varmı?
birde =Küçük($A$1:$M$1000;1) formulunu N1 hücresine yapıştırıp çıkan sonuca bakarmısınız sonuç 40562 den kucuk bir sayı çıkmaması lazım.

evet aralıkta boş hücreler ve tarih haricinde sayı ve metin içeren ifadeler var dediğiniz formülü uyguladım sonuç 1 çıktı.
a b c k sütunları ve 1 ve 2 satır hariç hep tarih
 
evet aralıkta boş hücreler ve tarih haricinde sayı ve metin içeren ifadeler var dediğiniz formülü uyguladım sonuç 1 çıktı.
a b c k sütunları ve 1 ve 2 satır hariç hep tarih

blirttiğiniz aralıkta tarih haricinde bulunan işlemlrdn kaynaklı problem var. işlem blirtiln aralıkta sadece tarih var diye formul yazmıştık şimdi başka bir formul bulmak gerekiyor ama sanırım biraz uğraıcaz:(
 
Kodu neden butonu kırmızı yapılan dosyadaki AutoOpen prosedürü oluşturup onun içine yazmıyorsunuz?Bence öyle daha kullanışlı olacaktır.:cool:
 
merhaba sayın evren
tam bilgim olmadığı için nasıl yapılacağını anlatırmısınız kod varsa kod ile
 
Geri
Üst