Skip to main content

AccessTr.neT


Commandbuttonları Koşullu Silme

Commandbuttonları Koşullu Silme

Çözüldü #1
Merhaba.

Ekte mor rekli butonların silinmemesi gerek.Diğer butonlar tablo1 deki verilere göre oluşuyor.

Visual Basic Code
       For Each con In .Controls
             If Not scr.exists(con.Name) Then DeleteControl frm.Name, con.Name
        Next


Yukarıdaki gibi  yapmam gerek.

Alttaki gibi silmek isteyincede döngüden erken şıkıp tamamını silmiyor hayret.
İnternetten do while formad.count>0 gibi bir kod buldum lakin onuda dictionary ile kullanamadım.



Visual Basic Code
For Each con In .Controls
 DeleteControl frm.Name, con.Name
 Next

[Resim: aTGIpva9.gif]
.rar Button ekleme kod ile kosullu.rar (Dosya Boyutu: 28,38 KB | İndirme Sayısı: 2)
Cevapla
#2
sorun
Visual Basic Code
       For Each con In .Controls
             If Not scr.exists(con.Name) Then DeleteControl frm.Name, con.Name
        Next
kodundan kaynaklanıyor. nesne silindiğinde atlayarak dolaşıyor nesneler arasında denemelerimde bir çift nesneleri atlayıp tek nesneleri sildi
kodu aşağıdaki gibi düzenleyip dener misiniz?
Visual Basic Code
Public Function butonYap()
    
    Dim db As dao.Database
    Dim rs As dao.Recordset
    Dim sqlStr As String
    Dim frm As Form
    Dim yeni As Control
    Dim i As Integer, say As Integer, ii As Integer
    Dim silinmemesiGerekenler
    Dim scr  As Object
    Dim toop As Integer
    Dim scrSil() As String

    Set scr = CreateObject("Scripting.Dictionary")
    silinmemesiGerekenler = Array("btn1", "btn2")

    DoCmd.OpenForm "Form1", acDesign
    Set frm = Forms("Form1")
    sqlStr = "SELECT * FROM Tablo1"

    Set db = CurrentDb
    Set rs = db.OpenRecordset(sqlStr)
''    On Error Resume Next
    
    With Forms("Form1")
        For i = LBound(silinmemesiGerekenler) To UBound(silinmemesiGerekenler)
              scr.Add silinmemesiGerekenler(i), ""
        Next
x = 0
        For Each con In .Controls
           If Not scr.exists(con.Name) Then
           ReDim Preserve scrSil(x)
           scrSil(x) = con.Name
           x = x + 1
           End If
        Next
   
For x = LBound(scrSil) To UBound(scrSil)
DeleteControl frm.Name, scrSil(x)
Next x
    End With

    
'    On Error GoTo 0
''''    Err.Clear
    rs.MoveFirst
    
    say = 1
    

Do Until rs.EOF
        If scr.exists(rs(0).Value) Then

        toop = 500 + 700 * ((say - 0.6) \ 4)

        Set yeni = CreateControl(frm.Name, acCommandButton, Left:=iLft, Top:=toop)

            yeni.Caption = rs!aa
            yeni.Name = "Button" & say
            yeni.Height = 500
            Set yeni = Nothing
            iLft = 13 + 2085 * (say Mod 4)
            say = say + 1
        End If
       rs.MoveNext
    Loop

    DoCmd.OpenForm "Form1", acNormal
    Forms("Form1").Form.Requery
    Set yeni = Nothing
    Set frm = Nothing
    Set scr = Nothing

End Function
Cevapla
#3
Sağol üstad hata verdi.

Alttaki gibi koşul olmadanda silmiyordu zaten.

Kod
For Each con In .Controls
 DeleteControl frm.Name, con.Name
Next

[Resim: do.php?img=9579]
Cevapla
#4
nasıl çalıştırdığınızı anlatır mısınız?
silinecek nesne varsa siler eğer yoksa hata vermesi normal çünkü dizinin boş olup olmadığını kontrol ettirömedim
Cevapla
#5
Kodlarınızın bazı yerlerini değiştirince çalıştı.Fakat daha anlamıyorum önceki yazdığım foreach olan neden çalışmaz.

For Each con In .Controls
DeleteControl frm.Name, con.Name
Next



Kod
ReDim scrSil(.Count)
 If x <= 1 Then GoTo git
  ReDim Preserve scrSil(x - 1)
 If scrSil(x) <> "" Then DeleteControl frm.Name, scrSil(x)


Değişenler yıkarda.
Kod
Public Function butonYap()
    
    Dim db As dao.Database
    Dim rs As dao.Recordset
    Dim sqlStr As String
    Dim frm As Form
    Dim yeni As Control
    Dim i As Integer, say As Integer, ii As Integer
    Dim silinmemesiGerekenler
    Dim scr  As Object
    Dim toop As Integer
    Dim scrSil() As String

    Set scr = CreateObject("Scripting.Dictionary")
    silinmemesiGerekenler = Array("btn1", "btn2")

    DoCmd.OpenForm "Form1", acDesign
    Set frm = Forms("Form1")
    sqlStr = "SELECT * FROM Tablo1"

    Set db = CurrentDb
    Set rs = db.OpenRecordset(sqlStr)
''    On Error Resume Next
    
    With Forms("Form1")
        For i = LBound(silinmemesiGerekenler) To UBound(silinmemesiGerekenler)
              scr.Add silinmemesiGerekenler(i), ""
        Next
x = 0
        ReDim scrSil(.Count)
        For Each con In .Controls
          If Not scr.exists(con.Name) Then          
          scrSil(x) = con.Name
          x = x + 1
          End If
        Next
        
  If x <= 1 Then GoTo git
  ReDim Preserve scrSil(x - 1)
    For x = LBound(scrSil) To UBound(scrSil)
        If scrSil(x) <> "" Then DeleteControl frm.Name, scrSil(x)
    Next x
    End With

git:
'    On Error GoTo 0
''''    Err.Clear
    rs.MoveFirst
    
    say = 1
    

Do Until rs.EOF
        If Not scr.exists(rs(0).Value) Then

        toop = 500 + 700 * ((say - 0.6) \ 4)

        Set yeni = CreateControl(frm.Name, acCommandButton, Left:=iLft, Top:=toop)

            yeni.Caption = rs!aa
            yeni.Name = "Button" & say
            yeni.Height = 500
            Set yeni = Nothing
            iLft = 13 + 2085 * (say Mod 4)
            say = say + 1
        End If
      rs.MoveNext
    Loop

    DoCmd.OpenForm "Form1", acNormal
    Forms("Form1").Form.Requery
    Set yeni = Nothing
    Set frm = Nothing
    Set scr = Nothing

End Function
.rar Button ekleme kod ile kosullu.rar (Dosya Boyutu: 34,46 KB | İndirme Sayısı: 1)
Son Düzenleme: 09/02/2020, 21:38, Düzenleyen: feraz.
Cevapla
#6
(09/02/2020 21:24)berduş Adlı Kullanıcıdan Alıntı: nasıl çalıştırdığınızı anlatır mısınız?
silinecek nesne varsa siler eğer yoksa hata vermesi normal çünkü dizinin boş olup olmadığını kontrol ettirömedim
Hatalı olarak örnek ekledim.


[Resim: do.php?img=9582]
.rar Button ekleme kod ile kosullu hatali.rar (Dosya Boyutu: 34,73 KB | İndirme Sayısı: 1)
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da