• DİKKAT

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

checkbox birden fazla kayıt yapma ve sıralama

Katılım
22 Ocak 2015
Mesajlar
6
Excel Vers. ve Dili
2013
Arkadaşlar linkte verdiğim test makro bir öncelışma bemin için.Amacım Kişiye ayit bilgileri userform üzerinden girdikten sonra worksheet lerde bulunan hazır şablonlara userformdaki girilen verileri tamaladıktan sonra birden fazla worksheet deki şablonları direk tek tıkla yazıcıdan almak istiyorum.

Gelelim sıkıntıma çook ama çook acemi olduğum için bunu beceremedim.
3 tane textbox var her textbox ta 2 tane checkbox tanımlı 1 checbox 1 ürün 2 checkbox 2 ürün textbox 1 arpa girdim 2 ye buğday 3 e yulaf checkbox 1 tıklayınca belirlediğim sutun ve aralıkta boş olana(A1den A6 kadartarayıp boş olana yazıyor) yazıyor. textbox1 deki yazının exel ürinde karışmaması için textbox 1 deki yazının adresini checkbox 1 e M1 checkbox 2 N1 tanımladım
böylece checkbox false ve true durumunda yazı asla karışmıyor. (Bunun yerine hafızaya alma gibi bir yöntem var ise buda olur.) şimdi 6 tane checkbox işaretli ve A1 den A6 ya kada ürünleri yazdı diyelim sonra aradan 2 üçtane check box kaldırdığımda a1 sütünundan siliyorun n1 vs hücre adresinide sildiriyorum. Ama A1 A6 arasında oluşan boşluğun altında ürün varsa yukarı çıksın iştiyorum bu ürünler yuları çıkarken textbox1 , 2 ,3 M ve N sütünundaki cell adress leride değişsinki o textboxtaki yazı silinip değiştirildiğinde hatalı yeri silip değiştirmesin.

Anlatabildimmi bilmiyorum ama yapmaya çalıştığım. checkbox işretlesemde kaldırsamda her işlemde textbox yazısının karıştırmadan İşaretli olan check boxları arada satırboşluğu olmadan sıralaması.

Şablonlarda değişiklik olmaması gerekiyor.yani satır sütün silme vs şablonu bozuyor.

https://drive.google.com/file/d/0B9QXMZrHa9JMaXVzQjhTbGEtdmc/view?usp=sharing



----------------------------------

Kod:
Private Sub cbk1_Click()
If cbk1.Value = True Then
For Each Cell In Range("A1:A6")
If Cell = "" Then
Range(Cell.Address).Value = txt1.Text
Range("M1").Value = Cell.Address
GoTo 1
Else

End If

Next
1:
End If
If cbk1.Value = False Then
Range(Range("M1").Cells).ClearContents
Range("M1").ClearContents
End If
End Sub

Private Sub cbk2_Click()
If cbk2.Value = True Then
For Each Cell In Range("A1:A6")
If Cell = "" Then
Range(Cell.Address).Value = txt2.Text
Range("M2").Value = Cell.Address
GoTo 1
Else

End If

Next
1:
End If
If cbk2.Value = False Then
Range(Range("M2").Cells).ClearContents
Range("M2").ClearContents
End If
End Sub

Private Sub cbk3_Click()
If cbk3.Value = True Then
For Each Cell In Range("A1:A6")
If Cell = "" Then
Range(Cell.Address).Value = txt3.Text
Range("M3").Value = Cell.Address
GoTo 1
Else

End If

Next
1:
End If
If cbk3.Value = False Then
Range(Range("M3").Cells).ClearContents
Range("M3").ClearContents
End If
End Sub

Private Sub cbs1_Click()
If cbs1.Value = True Then
For Each Cell In Range("A1:A6")
If Cell = "" Then
Range(Cell.Address).Value = txt1.Text & "(2)"
Range("N1").Value = Cell.Address
GoTo 1
Else

End If

Next
1:
End If
If cbs1.Value = False Then
Range(Range("N1").Cells).ClearContents
Range("N1").ClearContents
End If
End Sub
Private Sub cbs2_Click()
If cbs2.Value = True Then
For Each Cell In Range("A1:A6")
If Cell = "" Then
Range(Cell.Address).Value = txt2.Text & "(2)"
Range("N2").Value = Cell.Address
GoTo 1
Else

End If

Next
1:
End If
If cbs2.Value = False Then
Range(Range("N2").Cells).ClearContents
Range("N2").ClearContents
End If
End Sub

Private Sub cbs3_Click()
If cbs3.Value = True Then
For Each Cell In Range("A1:A6")
If Cell = "" Then
Range(Cell.Address).Value = txt3.Text & "(2)"
Range("N3").Value = Cell.Address
GoTo 1
Else

End If

Next
1:
End If
If cbs3.Value = False Then
Range(Range("N3").Cells).ClearContents
Range("N3").ClearContents
End If
End Sub

Private Sub clktemizle_Click()
Range("A1:A12,M1:M3,N1:N3").ClearContents
End Sub
 
Arkadaşlar birde textbox kullanımında Örneğin a yada A basıldığında aile başlayan tanımlanmış kelimelerin gelmesi mümkünmü ARPA ASPİR gibi :)
 
arkadaşlar yardımcı olacak yokmu ?
 
Geri
Üst