मेरे पास एक शीट है जहां मैं चेकबॉक्स जोड़ रहा हूं यदि एरेंज खाली नहीं है। लेकिन मैं यह भी चाहता हूं कि गतिशील रूप से अगर यह सीमा घटती है तो इसका मूल्य (5 से 3 तक जाता है, उदाहरण के लिए) मैं इन अन्य चेकबॉक्स को हटाना चाहता हूं।
उदाहरण के लिए, मेरे पास 4 भरी हुई पंक्तियाँ हैं और मेरे कोड में 4 चेकबॉक्स जोड़े गए हैं:
लेकिन तब मैंने 2 पंक्तियों को हटा दिया था, इसलिए मुझे उम्मीद थी कि ये चेकबॉक्स भी हटा दिए गए हैं, लेकिन जब मैं फिर से कोड चलाता हूं तो मुझे अभी भी ये चेकबॉक्स मिलते हैं:
यह वही है जो मैंने अब तक कोशिश की है और इसका कुछ हिस्सा मैं से लिया है इस उत्तर, लेकिन यह काम नहीं किया:
Option Explicit
Sub AddCheckbox()
Dim i As Long, lastrow As Long, rng As Range
Dim ws As Worksheet
Dim obj As OLEObject, cb As MSForms.CheckBox
Set ws = Sheets("Consulta")
lastrow = ws.Cells(Rows.Count, "E").End(xlUp).Row
For i = 5 To lastrow
If Not IsEmpty(ws.Range("E" & i, "J" & i)) Then
For Each rng In ws.Range("D" & i)
ws.OLEObjects.Add "Forms.CheckBox.1", Left:=rng.Left, Top:=rng.Top, Width:=rng.Width, Height:=rng.Height
Next
ElseIf IsEmpty(ws.Range("E" & i, "J" & i)) Then
For Each obj In ws.OLEObjects
If TypeOf obj.Object Is MSForms.CheckBox Then
Set cb = obj.Object
If cb.ShapeRange.Item(1).TopLeftCell.Address = _
ActiveCell.Address Then obj.Delete
End If
Next
End If
Next
End Sub
कोई सुझाव मदद करेगा! मैं वास्तव में विश्वास करता हूं कि समस्या इस भाग के साथ है:
If cb.ShapeRange.Item(1).TopLeftCell.Address = _
ActiveCell.Address Then obj.Delete
End If
उत्तर:
जवाब के लिए 2 № 1यह महान नहीं है लेकिन काम करता है:
Sub AddCheckbox()
Const RW_START As Long = 5
Dim i As Long, lastrow As Long, rng As Range
Dim ws As Worksheet, o As Object, v
Dim obj As OLEObject, cb "As MSForms.CheckBox
Set ws = Sheets("Consulta")
lastrow = 500 "ws.Cells(Rows.Count, "E").End(xlUp).Row
"^^^ not sure what would be the best approach here...
For i = RW_START To lastrow
If Application.CountA(ws.Range("E" & i & ":J" & i)) > 0 Then
With ws.Range("D" & i)
"not already added a checkbox?
If Len(.Value) = 0 Then
Set o = ws.OLEObjects.Add("Forms.CheckBox.1", _
Left:=.Left, Top:=.Top, _
Width:=.Width, Height:=.Height)
"create a name for the checkbox and link it to the cell
v = Application.Max(ws.Cells(RW_START, "D").Resize(1000, 1))
v = v + 1
o.Name = "cbx_" & v
.Value = v
.Font.Color = vbWhite
Debug.Print i, v
End If
End With
Else
On Error Resume Next
ws.Shapes(ws.Range("D" & i).Value).Delete
On Error GoTo 0
ws.Range("D" & i).Value = ""
End If
Next
End Sub