Makro einfügen aber wo ?
23.01.2005 09:10:48
Heinz
Habe von Makros leider "noch" soviel Ahnung wie ein Schwein vom Weitspringen.
Habe Dank Eurer Hilfe einiges weitergebracht. Aber nun stehe ich vor einer Mauer.
Habe im unterstehenden Link meine Mappe hochgeladen,nun würde die unterstehende Formel noch eingebaut gehören.Aber wo und wie?
Könnte mir BITTE jemand helfen.
Danke Heinz
Die Datei https://www.herber.de/bbs/user/16634.xls wurde aus Datenschutzgründen gelöscht
'in das Tabellenmodul
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Intersect(Target, [c6:c52]) Is Nothing Then
Call pause_akt_Z
ActiveCell.Offset(0, 3).Activate
End If
End Sub
'für die gesamte Tabelle
Public Sub pause_ges_Tab()
Dim wt As Byte, i%, x As Byte, optB$
Dim sh As Worksheet
Dim sh1 As Worksheet
Set sh = Worksheets("blatt")
Set sh1 = Worksheets("Legende")
For x = 1 To 5
If sh1.OLEObjects(x).Object = True Then
optB = sh1.OLEObjects(x).Name
End If
Next
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
For i = 6 To 52
wt = Weekday(sh.Cells(i, 2))
Select Case optB
Case "OptionButton1"
If wt = 2 Then
Range(sh.Cells(i, 4), sh.Cells(i, 5)) = ""
Else
sh.Cells(i, 4) = 11#
sh.Cells(i, 5) = 11.5
End If
Case "OptionButton2"
If wt = 3 Then
Range(sh.Cells(i, 4), sh.Cells(i, 5)) = ""
Else
sh.Cells(i, 4) = 11#
sh.Cells(i, 5) = 11.5
End If
Case "OptionButton3"
If wt = 4 Then
Range(sh.Cells(i, 4), sh.Cells(i, 5)) = ""
Else
sh.Cells(i, 4) = 11#
sh.Cells(i, 5) = 11.5
End If
Case "OptionButton4"
If wt = 5 Then
Range(sh.Cells(i, 4), sh.Cells(i, 5)) = ""
Else
sh.Cells(i, 4) = 11#
sh.Cells(i, 5) = 11.5
End If
Case "OptionButton5"
If wt = 6 Then
Range(sh.Cells(i, 4), sh.Cells(i, 5)) = ""
Else
sh.Cells(i, 4) = 11#
sh.Cells(i, 5) = 11.5
End If
End Select
Next
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub
'für die Eingabe in der Zeile
Sub pause_akt_Z()
Dim wt As Byte, i%, x As Byte, optB$
Dim sh As Worksheet
Dim sh1 As Worksheet
Set sh = Worksheets("blatt")
Set sh1 = Worksheets("Legende")
For x = 1 To 5
If sh1.OLEObjects(x).Object = True Then
optB = sh1.OLEObjects(x).Name
End If
Next
i = ActiveCell.Row
wt = Weekday(sh.Cells(i, 2))
Select Case optB
Case "OptionButton1"
If wt = 2 Then
Range(sh.Cells(i, 4), sh.Cells(i, 5)) = ""
Else
sh.Cells(i, 4) = 11#
sh.Cells(i, 5) = 11.5
End If
Case "OptionButton2"
If wt = 3 Then
Range(sh.Cells(i, 4), sh.Cells(i, 5)) = ""
Else
sh.Cells(i, 4) = 11#
sh.Cells(i, 5) = 11.5
End If
Case "OptionButton3"
If wt = 4 Then
Range(sh.Cells(i, 4), sh.Cells(i, 5)) = ""
Else
sh.Cells(i, 4) = 11#
sh.Cells(i, 5) = 11.5
End If
Case "OptionButton4"
If wt = 5 Then
Range(sh.Cells(i, 4), sh.Cells(i, 5)) = ""
Else
sh.Cells(i, 4) = 11#
sh.Cells(i, 5) = 11.5
End If
Case "OptionButton5"
If wt = 6 Then
Range(sh.Cells(i, 4), sh.Cells(i, 5)) = ""
Else
sh.Cells(i, 4) = 11#
sh.Cells(i, 5) = 11.5
End If
End Select
End Sub