Makro mit Optionsfeld an und ausmachen
14.09.2005 08:40:48
Markus
ich möchte gerne dieses Makro mit einem Optionsfeld an und ausmachen können.
Das Optionsfeld ist nicht das Problem, sonder der Code.
Vielen Dank im Voraus.
Gruß
Markus
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim zelle As Range
Dim wert As String
Dim bereich As Range
Set bereich = Sheets("susa").Range("c5:c106")
'erste Spalte:
If Not Intersect(Target, Range("j5:j52")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
For Each zelle In bereich
If zelle = Target.Offset(0, -8) Then wert = wert & zelle.Offset(0, 38) & vbLf
Next
With Me.Shapes("Textfeld 93")
.TextFrame.Characters.Text = wert
.Left = Target.Left + Target.Width
.Top = Target.Top + Target.Height
.Visible = True
End With
'zweite Spalte:
ElseIf Not Intersect(Target, Range("i5:i52")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
For Each zelle In bereich
If zelle = Target.Offset(0, -7) Then wert = wert & zelle.Offset(0, 35) & vbLf
Next
With Me.Shapes("Textfeld 93")
.TextFrame.Characters.Text = wert
.Left = Target.Left + Target.Width
.Top = Target.Top + Target.Height
.Visible = True
End With
'dritte Spalte:
ElseIf Not Intersect(Target, Range("h5:h52")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
For Each zelle In bereich
If zelle = Target.Offset(0, -6) Then wert = wert & zelle.Offset(0, 34) & vbLf
Next
With Me.Shapes("Textfeld 93")
.TextFrame.Characters.Text = wert
.Left = Target.Left + Target.Width
.Top = Target.Top + Target.Height
.Visible = True
End With
'vierte Spalte:
ElseIf Not Intersect(Target, Range("g5:g52")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
For Each zelle In bereich
If zelle = Target.Offset(0, -5) Then wert = wert & zelle.Offset(0, 33) & vbLf
Next
With Me.Shapes("Textfeld 93")
.TextFrame.Characters.Text = wert
.Left = Target.Left + Target.Width
.Top = Target.Top + Target.Height
.Visible = True
End With
'fünfte Spalte:
ElseIf Not Intersect(Target, Range("f5:f52")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
For Each zelle In bereich
If zelle = Target.Offset(0, -4) Then wert = wert & zelle.Offset(0, 32) & vbLf
Next
With Me.Shapes("Textfeld 93")
.TextFrame.Characters.Text = wert
.Left = Target.Left + Target.Width
.Top = Target.Top + Target.Height
.Visible = True
End With
'weder noch:
Else
With Me.Shapes("Textfeld 93")
.Visible = False
End With
End If
End Sub