AW: Makro automatisch ausführen
27.06.2007 13:54:05
Wrobel
Hi!
Vielen Dank für die Hilfe, allerdings bekomme ich eine Fehlermeldung.
"Fehler beim Kompilieren:
Mehrdeutiger Name: Worksheet_Change"
Habe z.Z. folgendes in meiner Tabelle enthalten:
Option Explicit
Private Sub ToggleButton1_Click()
Range("i10").Value = 2 + ToggleButton1.Value
ToggleButton1.Caption = IIf(ToggleButton1.Value, "Preisanfrage", "Bestellung")
End Sub
Private Sub ToggleButton2_Click()
Range("i" & ActiveCell.Row).Value = 2 + ToggleButton1.Value
ToggleButton1.Caption = IIf(ToggleButton1.Value, "Preisanfrage", "Bestellung")
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ii As Integer
For ii = 4 To 8 ' Zeilen 4 bis 8
If Not Intersect(Cells(ii, 5), Target) Is Nothing Then ' Spalte 5 = E
If BlattNam_Pruefung(Cells(ii, 5)) Then
Sheets(ii + 1).Name = Cells(ii, 5) ' Blätter 5 bis 9
Else
MsgBox "E" & ii & " enthält keinen gültigen Blattnamen: " & vbLf & Cells(ii, 5)
End If
End If
Next ii
End Sub
Function BlattNam_Pruefung(BlaNam As String) As Boolean
' www.excelformeln.de/formeln.html?welcher=96
' www.xlam.ch/pos/rules.htm#Richtlinien%20f%FCr%20Arbeitsblatt-Namen
If BlaNam = "" Or Len(BlaNam) > 31 Then Exit Function
If Application.Evaluate("=SUM((MID(""" & BlaNam & """,COLUMN(1:1),1)" & _
"={"":"";""/"";""\"";""?"";""*"";""]"";""[""})*1)") > 0 Then Exit Function
BlattNam_Pruefung = True
End Function
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$9" Then
Formelkopieren
End Sub