View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Tom Ogilvy Tom Ogilvy is offline
external usenet poster
 
Posts: 27,285
Default How can I optimize this code?

You know the cell, but you don't know which checkbox is over that cell.
Thus you have to loop.

the only way to get around this would be to alter the oleObject name of the
checkbox so it can be constructed from the cell address.

for instance cboxB9

sStr = "cbox" & wsCells(z,s).Address(0,0)

set oleobj = Nothing
on Error Resume Next
set oleobj = ws.OleObjects(sStr)
On Error goto 0
if not oleObj is nothing then
wert = wert + 1

--
Regards,
Tom Ogilvy


wullux wrote in message
...
Hello,

I have many sheets with many checkboxes! My problem is, that the
function checks each checkboxes (until Zelle.Address =
ol.TopLeftCell.Address!), although the address of the searched checkbox
is known (Set rng = ws.Cells(z, s)).
Is it possible to check only the searched checkbox (=ws.cells(z,s)) in
the function?

Thanks a lot for help,
wullux


Sub Auswertung()
Dim rng As Range
Dim ws As Worksheet
Dim j As Integer
Dim s As Integer
Dim wert As Integer
Dim z As Integer
Dim lngletztezeile As Integer
For j = 1 To Worksheets.Count
For s = 2 To 32
wert = 0
lngletztezeile = Worksheets(j).Cells(Worksheets(j).Rows.Count,
1).End(xlUp).row
For z = 4 To lngletztezeile
Set ws = ThisWorkbook.Worksheets(j)
Set rng = ws.Cells(z, s)
If ZelleHatOLEObject(Zelle:=rng, blatt:=ws) Then
wert = wert + 1
Tabelle1.Cells(j, s) = wert
End If
Next z
Next s
Tabelle1.Cells(j, 33) = WorksheetFunction.Sum(Cells(j, 2), Cells(j,
3))
Next j
Set ws = Nothing
Set rng = Nothing
End Sub

Function ZelleHatOLEObject(Zelle As Range, blatt As Worksheet) As
Boolean
Dim ol As OLEObject
ZelleHatOLEObject = False
For Each ol In blatt.OLEObjects
If Zelle.Address = ol.TopLeftCell.Address Then
If ol.Object.Value = True Then
ZelleHatOLEObject = True
Exit Function
End If
End If
Next ol
End Function


---
Message posted from http://www.ExcelForum.com/