Danke Daniel für die Info ! Jetzt noch die letzte
05.03.2017 13:34:09
walter
Hallo Daniel und Mullit,
anbei die beiden Makros von Mullit, alles i.o. !!!!!!!!!!!!!!
Aber ich möchte gern das, wenn eine Master Sheet vorhanden ist,
daraus NICHT berücksichtigt wird !
Und dann ist Schlussssss
Public Sub Klicks_anzeigen()
Dim wksSheet As Worksheet
Dim objOLEObject As OLEObject
Dim objButtonRange As Range
Dim alngCount() As Long
Dim ialngCount As Long
Dim blnFirstSheet As Boolean
With ThisWorkbook
' Set objButtonRange = .Worksheets("Übersicht").Range("D59:I62") '// Button-Bereich in 'Ü _
bersicht'-Sheet anpassen...
Set objButtonRange = .Worksheets("Übersicht").Range("D59:I67,D69:I71,D83:I87,D89:I93")
For Each wksSheet In .Worksheets
If Not wksSheet Is .Worksheets("Übersicht") Then
For Each objOLEObject In wksSheet.OLEObjects
With objOLEObject
If .progID = "Forms.OptionButton.1" Then
ialngCount = ialngCount + 1
With .Object
If Not blnFirstSheet Then
ReDim Preserve alngCount(ialngCount - 1) As Long
If .Value Then alngCount(ialngCount - 1) = 1
ElseIf .Value Then
alngCount(ialngCount - 1) = alngCount(ialngCount - 1) + 1
End If
End With
End If
End With
Next
blnFirstSheet = True
ialngCount = 0
End If
Next
Call objButtonRange.ClearContents
For Each objOLEObject In .Worksheets("Übersicht").OLEObjects
With objOLEObject
If .progID = "Forms.OptionButton.1" Then
ialngCount = ialngCount + 1
If alngCount(ialngCount - 1) > 0 Then _
.TopLeftCell.Value = alngCount(ialngCount - 1)
End If
End With
Next
End With
Set objButtonRange = Nothing
End Sub
'----------------- texte zusammenfügen ------------------------
Public Sub Texte_zusammensetzen()
Const START_ROW As Long = 98 '// erste Text-Zeile der 'Tabgroups'
Const START_COLUMN As Long = 3 '// erste Spalte der 'Tabgroups'
Dim wksSheet As Worksheet
Dim astrText() As String
Dim lngRow As Long, lngColumn As Long
Dim ialngIndex As Long, lngCount As Long
Dim blnFirstSheet As Boolean
With ThisWorkbook
For Each wksSheet In .Worksheets
If Not wksSheet Is .Worksheets("Übersicht") Then
With wksSheet
lngCount = .Cells(START_ROW, START_COLUMN).MergeArea.Columns.Count
For lngRow = 0 To 6 Step 2
lngColumn = START_COLUMN
Do
ialngIndex = ialngIndex + 1
With .Cells(lngRow + START_ROW, lngColumn)
If Not blnFirstSheet Then
ReDim Preserve astrText(ialngIndex - 1) As String
If .Value vbNullString Then _
astrText(ialngIndex - 1) = .Value
ElseIf .Value vbNullString Then
astrText(ialngIndex - 1) = astrText(ialngIndex - 1) & "; " & . _
Value
End If
End With
lngColumn = lngColumn + lngCount
Loop While lngColumn
mdfg
walter mb