Neue VBA Modul Hilfe

frosch38 · 16. Oktober 2008 um 16:15

Hallo Leute
Ich habe eine alte VBA Dienstplan umgebaut und es fehlt mir ein paar befehle noch.
Ich möchte ein Warnfenster erstellen, die geht auf wenn man trägt ein Mitarbeiter von Spätdienst auf Frühdienst.
Ich habe schon Warnfenster in den dienstplan aber nur wenn man trägt jemand doppelt.
Vielleicht kann man die umbauen?

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.Index 17 Then Exit Sub
Spalte = Target.Column
Zeile = Target.Row
If Spalte 32 Then Exit Sub
If Not Intersect(Target, ActiveSheet.Range(Cells(5, Spalte), Cells(27, Spalte))) Is Nothing Then
Call Zeit_Eintragen
End If

End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Spalte = ActiveWindow.ActiveCell.Column
If ActiveSheet.Index 15 Then Exit Sub
If Spalte 32 Then Exit Sub
If Target.Count > 1 Then Exit Sub
temp = „“
Set BereichB = ActiveSheet.Range(Cells(5, Spalte), Cells(21, Spalte))
If Target.Value = „“ Then Exit Sub

z = 0
Set rngSuchBereich = BereichB.Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not rngSuchBereich Is Nothing Then
FirstAddress = rngSuchBereich.Address
Do
z = z + 1
Set rngSuchBereich = BereichB.FindNext(After:=rngSuchBereich)
temp = temp & rngSuchBereich.Row & „#“

If rngSuchBereich.Address = FirstAddress Then Exit Do
Loop
End If
temp = Split(temp, „#“)
If UBound(temp) > 1 Then
If ActiveCell.Row > 17 Then u = temp(1)
If ActiveCell.Row Spalte Then
Cells(ActiveCell.Row, Spalte).Value = „“
Else
Cells(Zeile, Spalte).Value = „“
End If
Exit Sub
End Select
Exit Sub
End If

If z = 3 And u Spalte Then
Cells(ActiveCell.Row, Spalte).Value = „“
Else
Cells(Zeile, Spalte).Value = „“
End If

Exit Sub
End Select
Exit Sub
End If

If z > 3 And u Spalte Then
Cells(ActiveCell.Row, Spalte).Value = „“
Else
Cells(Zeile, Spalte).Value = „“
End If
Exit Sub

End If
If z = 2 And u > 17 Then
Select Case MsgBox(„Dieser Mitarbeiter hat Urlaub!“ _
& vbCrLf & _
vbCrLf & _
„Trotzdem eintragen ?“ _
, vbYesNo Or vbExclamation Or vbDefaultButton1, „Sorry“)
Case vbYes
Call Zeit_Eintragen

Case vbNo
If ActiveCell.Column Spalte Then
Cells(ActiveCell.Row, Spalte).Value = „“
Else
Cells(Zeile, Spalte).Value = „“
End If
Exit Sub
End Select
Exit Sub
End If
If z > 2 And u > 17 Then

Select Case MsgBox(„vvvDieser Mitarbeiter hat Urlaub!!!“ _
& vbCrLf & _
„Trotzdem eintragen ?“ _
, vbYesNo Or vbExclamation Or vbDefaultButton1, „Sorry“)

Case vbYes
Call Zeit_Eintragen
Case vbNo
If ActiveCell.Column Spalte Then
Cells(ActiveCell.Row, Spalte).Value = „“
Else
Cells(Zeile, Spalte).Value = „“
End If
Exit Sub
End Select
Exit Sub
End If

End Sub

Reinhard_fb8cb7 · 16. Oktober 2008 um 16:39

Hi Patrick,

schreibe bitte einen neuen Beitrag, wo du den Code ich die eckigen Klammerpaare vom pre-tag schreibst, der pre-Tag wird unterhalb des Eingabefensters erläutert.

Zum Code, so auf den ersten Blick,
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Spalte = ActiveWindow.ActiveCell.Column
If ActiveSheet.Index 15 Then Exit Sub
If Spalte 32 Then Exit Sub

Exit Sub wird immer ausgeführt da Spalte 0 ist.

Gruß
Reinhard

frosch38 · 16. Oktober 2008 um 19:14

Hallo Reinhard
Jetzt habe ich das so geschrieben. Aber Excel sag mir Mehrdeutige Namen"Workbook_SheetChange"

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Spalte = ActiveWindow.ActiveCell.Column
If ActiveSheet.Index 15 Then Exit Sub
If Spalte 32 Then Exit Sub
If Target.Count > 1 Then Exit Sub
temp = „“
Set BereichB = ActiveSheet.Range(Cells(5, Spalte), Cells(21, Spalte))
If Target.Value = „“ Then Exit Sub

z = 0
Set rngSuchBereich = BereichB.Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not rngSuchBereich Is Nothing Then
FirstAddress = rngSuchBereich.Address
Do
z = z + 1
Set rngSuchBereich = BereichB.FindNext(After:=rngSuchBereich)
temp = temp & rngSuchBereich.Row & „#“

If rngSuchBereich.Address = FirstAddress Then Exit Do
Loop
End If
temp = Split(temp, „#“)
If UBound(temp) > 1 Then
If ActiveCell.Row > 15 Then u = temp(1)
If ActiveCell.Row Spalte Then
Cells(ActiveCell.Row, Spalte).Value = „“
Else
Cells(Zeile, Spalte).Value = „“
End If
Exit Sub
End Select
Exit Sub
End If

If z = 3 And u Spalte Then
Cells(ActiveCell.Row, Spalte).Value = „“
Else
Cells(Zeile, Spalte).Value = „“
End If

Exit Sub
End Select
Exit Sub
End If

If z > 3 And u Spalte Then
Cells(ActiveCell.Row, Spalte).Value = „“
Else
Cells(Zeile, Spalte).Value = „“
End If
Exit Sub

End If
If z = 2 And u > 15 Then
Select Case MsgBox(„Dieser Mitarbeiter hat Urlaub!“ _
& vbCrLf & _
vbCrLf & _
„Trotzdem eintragen ?“ _
, vbYesNo Or vbExclamation Or vbDefaultButton1, „Sorry“)
Case vbYes
Call Zeit_Eintragen

Case vbNo
If ActiveCell.Column Spalte Then
Cells(ActiveCell.Row, Spalte).Value = „“
Else
Cells(Zeile, Spalte).Value = „“
End If
Exit Sub
End Select
Exit Sub
End If
If z > 2 And u > 15 Then

Select Case MsgBox(„vvvDieser Mitarbeiter hat Urlaub!!!“ _
& vbCrLf & _
„Trotzdem eintragen ?“ _
, vbYesNo Or vbExclamation Or vbDefaultButton1, „Sorry“)

Case vbYes
Call Zeit_Eintragen
Case vbNo
If ActiveCell.Column Spalte Then
Cells(ActiveCell.Row, Spalte).Value = „“
Else
Cells(Zeile, Spalte).Value = „“
End If
Exit Sub
End Select
Exit Sub
End If

End Sub

[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]

Reinhard_fb8cb7 · 17. Oktober 2008 um 16:20

Jetzt habe ich das so geschrieben. Aber Excel sag mir
Mehrdeutige Namen"Workbook_SheetChange"

Hi Patrick,

es darf nur eine Prozedur geben, die den Namen „Workbook_SheetChange“ trägt.

Um Code besser lesen zu können benutzt man vorne in den Codezeilen Einrückungen durch Leerzeichen bei Schleifen usw.
Wenn du hier Code zeigst, mußt du den pre-Tag benutzen damit diese Einrückungen erhalten bleiben.

Also bei der Eingabe nicht so schreiben:

For N=1 To 10
 Msgbox N
Next N

denn das erscheint dann hier so:

For N=1 To 10
Msgbox N
Next N

sondern einfach vor und nach dem Code den pretag benutzen, also sieht deine Eingabe so aus:

    For N=1 To 10
     Msgbox N
    Next N

und das was hier dann angezeigt wird so:

For N=1 To 10
 Msgbox N
Next N

Und du hast, naja nicht wirklich, aber für hiesige Verhältnisse schon langen Code und ohne Einrückungen habe ich echt wenig Bock mir das anzuschauen.

Gruß
Reinhard