stok ekleme düğmesini etkinleştirme

[kbrhlm2008]

Selam arkadaşlar bu formde okuduğum bi konuda adıhayat arkadaşımızın yapmak istediği stok girme problemini bende yaşıyorum zfr19 arkadaşımız sağolsun çözmüş bu olayı acaba banada yardım edermisiz ekteki hazırlamış olduğum tablomda stok ekle butonunu aktif hale getiremedim ve birde arama bölümleri oluşturdum her bölüm kendi sutunu altındaki 3. satırla 252. satır arası arama yapmasını istiyorum bunu yaptımda ama exceli kaydetmeyi başaramıyorum yardımlarınızı bekliyorum acil olarak.... dosyam ektedir...


şimdiden teşekkür ederim
Ekli dosyayı görüntüle Kopya STOK TAKİP (Kübra Petshop).xlsx

 

[cems]

Ekte dosya yok

 

[kbrhlm2008]

'Pencereler arası geçişte raporları yenile
'Private Sub Worksheet_Deactivate()
'Dim pt As PivotTable
'For Each pt In ActiveSheet.PivotTables
'pt.RefreshTable
'Next pt
'End Sub

Private Sub TextBox1_Change() ' Ürün Adı suzme islemi
On Error Resume Next

METIN = TextBox1.Value
Set FC2 = Range("D3252").Find(What:=METIN)
Application.GoTo Reference:=Range(FC2.Address), _
Scroll:=False
Selection.AutoFilter
ActiveSheet.Range("$D$2:$D$252").AutoFilter Field:=1, Criteria1:="*" & TextBox1.Value & "*"
If METIN = "" Then
Selection.AutoFilter Field:=1
Worksheets("2012").AutoFilterMode = False
Range("D65536").End(xlUp).Offset(1, 0).Select ' Aşağıdan başlayarak A sütununda en son dolu satırın altındaki boş hücre
End If
End Sub

'Pencereler arası geçişte raporları yenile
'Private Sub Worksheet_Deactivate()
'Dim pt As PivotTable
'For Each pt In ActiveSheet.PivotTables
'pt.RefreshTable
'Next pt
'End Sub

Private Sub TextBox2_Change() ' markası suzme islemi
On Error Resume Next

METIN = TextBox2.Value
Set FC2 = Range("B3:B252").Find(What:=METIN)
Application.GoTo Reference:=Range(FC2.Address), _
Scroll:=False
Selection.AutoFilter
ActiveSheet.Range("$B$2:$B$252").AutoFilter Field:=1, Criteria1:="*" & TextBox2.Value & "*"
If METIN = "" Then
Selection.AutoFilter Field:=1
Worksheets("2012").AutoFilterMode = False
Range("B65536").End(xlUp).Offset(1, 0).Select ' Aşağıdan başlayarak A sütununda en son dolu satırın altındaki boş hücre
End If
End Sub

'Pencereler arası geçişte raporları yenile
'Private Sub Worksheet_Deactivate()
'Dim pt As PivotTable
'For Each pt In ActiveSheet.PivotTables
'pt.RefreshTable
'Next pt
'End Sub

Private Sub TextBox3_Change() ' cinsi suzme islemi
On Error Resume Next

METIN = TextBox3.Value
Set FC2 = Range("C3:C252").Find(What:=METIN)
Application.GoTo Reference:=Range(FC2.Address), _
Scroll:=False
Selection.AutoFilter
ActiveSheet.Range("$C$2:$C$252").AutoFilter Field:=1, Criteria1:="*" & TextBox3.Value & "*"
If METIN = "" Then
Selection.AutoFilter Field:=1
Worksheets("2012").AutoFilterMode = False
Range("C65536").End(xlUp).Offset(1, 0).Select ' Aşağıdan başlayarak A sütununda en son dolu satırın altındaki boş hücre
End If
End Sub



'Pencereler arası geçişte raporları yenile
'Private Sub Worksheet_Deactivate()
'Dim pt As PivotTable
'For Each pt In ActiveSheet.PivotTables
'pt.RefreshTable
'Next pt
'End Sub

Private Sub TextBox10_Change() ' kilosu suzme islemi
On Error Resume Next

SAYI = TextBox10.Value
Set FC2 = Range("E3:E252").Find(What:=SAYI)
Application.GoTo Reference:=Range(FC2.Address), _
Scroll:=False
Selection.AutoFilter
ActiveSheet.Range("$E$2:$E$252").AutoFilter Field:=1, Criteria1:="*" & TextBox10.Value & "*"
If SAYI = "" Then
Selection.AutoFilter Field:=1
Worksheets("2012").AutoFilterMode = False
Range("E65536").End(xlUp).Offset(1, 0).Select ' Aşağıdan başlayarak A sütununda en son dolu satırın altındaki boş hücre
End If
End Sub

 

[kbrhlm2008]

YUKARIDA GÖNDERDİĞİM KODLARI KENDİM YAZDIM HER BÖLMENİN KENDİ SUTUNUNDAKİ SATIR3 VE SATIR252 ARASI HARF UYUMUNA GÖRE ARAMA YAPMASINA YARIYOR YANİ ÇALIŞIYOR AMA DOSYAYI KAYDET DEDİĞİMDE HATA OLUŞUYO KAYDETMİYOR YANİ NOLUR YARDIMCI OLUN BANA NE YAPMAM GEREKİYOR YUKARIDAKİ KODLARI geliştirici>tasarım modu>visual basic KAYDETİP TASARIM MODU KAPATIYORUM SİSTEM ÇALIŞIYO AMA DEDİĞİM GİBİ KAYDETMİYOR....

HELP HELP HELP

 

[kbrhlm2008]

ekte dosya yok

alt tarafa tekrar ekledim

 

[kbrhlm2008]

Ekli dosyayı görüntüle STOK TAKİP (Kübra Petshop).xlsx dosya bu arkadaşlar
Ekli dosyayı görüntüle STOK TAKİP (Kübra Petshop).xlsx