How can I optimize this code?
 

Hello,

I have many sheets with many checkboxes! My problem is, that th
function checks each checkboxes (until Zelle.Address
ol.TopLeftCell.Address!), although the address of the searched checkbo
is known (Set rng = ws.Cells(z, s)).
Is it possible to check only the searched checkbox (=ws.cells(z,s)) i
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) A
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 Functio

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

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/

How can I optimize this code?
 

Hello Tom,

Thank you very much for your Help!!!
I now solved the problem this way...

Regards,
wullux

Sub Auswertung()
Dim rng As String
Dim ws As Worksheet
Dim j As Integer
Dim wert As Integer
Dim z As Integer
Dim lngletztezeile As Integer
Dim ol As OLEObject
Dim s As String
For j = 1 To Worksheets.Count
For Each ol In Worksheets(j).OLEObjects
Application.EnableEvents = False
rng = ol.TopLeftCell.Address
s = Mid(rng, 2, InStr(2, rng, "$") - 2)
z = Right(rng, Len(rng) - InStr(2, rng, "$"))
If ol.Object.Value = True Then
If Worksheets(j).Cells(z, 1).Value = "Ausgefallen" Then
Tabelle1.Cells(j, Columns(s).column).Interior.ColorIndex = 3
GoTo nextol
End If
wert = Tabelle1.Cells(j, Columns(s).column).Value
wert = wert + 1
Tabelle1.Cells(j, Columns(s).column).Value = wert
End If
nextol:
Next ol
Application.EnableEvents = True
On Error GoTo 1
Tabelle1.Cells(j, 33) = WorksheetFunction.Sum(Cells(j, 2), Cells(j
3))
1:
Next j
Exit Sub
End Su

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