Commandbuttonları Koşullu Silme

1 2 3 4
09/02/2020, 19:32

feraz

Merhaba.

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

       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.



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


sorun
       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?
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
09/02/2020, 21:14

feraz

Sağol üstad hata verdi.

Alttaki gibi koşul olmadanda silmiyordu zaten.

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


09/02/2020, 21:24

berduş

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
09/02/2020, 21:34

feraz

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
09/02/2020, 21:47

feraz

(09/02/2020, 21:24)berduş yazdı: 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.



1 2 3 4