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
Sağol üstad hata verdi.
Alttaki gibi koşul olmadanda silmiyordu zaten.
Kod:
For Each con In .Controls
DeleteControl frm.Name, con.Name
Next
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
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: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.