|
Hallo Forumsmitglieder,
evt. könnt ihr mir helfen mein Problem zu lösen, an dem ich schon die ganze Zeit scheitere. Bei dem VBA Programm handelt es sich um einen Plan, welcher anzeigt wie welcher Mitarbeiter wo eingesetzt ist. Das ganze ist in einer VBA Datenbank hinterlegt und wird ausgelesen. Nun kann man ja jede Zelle einzeln kommentieren, auch dazu habe ich eine Funktion die perfekt funktioniert. Geplant ist aber das auf Wunsch die Zelle hervorgehoben wird, wenn ein Kommentar dort drin steht. Dies habe ich mit einer Checkbox realisiert, dessen Wert in der DB abgespeichert ist. In dem folgendem Codeteil wird dieser Wert ausgelesen, und wenn hervorheben angekreuzt, bzw. TRUE ist dann sollte er z.B. den Zellenrand umfärben um die Zelle hervorzuheben. Also die Abfrage funktioniert, habe diese mit einzelschritt überwacht. Er Springt dann in den Teil bei dem er den Rand mit With auf Rot umschreiben und fetter werden lassen soll. Diesen Teil läuft er auch durch, aber passieren tut leider nichts. Ich habe auch schon versucht die Zelle mit z.B. ActiveCell.Font.Colorindex=3 umzufärben, was auch nicht funktioniert. Er färbt dann teilweise andere Zellen ein bei denen das Bit nicht aktiviert ist. Die bedingten Formatierungen habe ich auch mal testweise alle gelöscht, weil ich dachte hier könnte der Fehler liegen, aber brachte leider auch nichts.
vielen Dank schon mal
gruß
Public Function Vorbelegung_auslesen_Planung(userschicht As Integer, Bereich As Integer, Jahr As Integer) As Boolean
Dim Stammnummer As Long
Dim Kommentar As String
Dim a, b, c, d As Integer
Dim Datum As String
'Datenbankverbindung öffnen
If DB_oeffnen() = False Then
MsgBox ("Die Datenbank konnte nicht geoeffnet werden.")
Vorbelegung_auslesen_Planung = False
Exit Function
End If
Range(Tabelle1.Cells(5, 15), Tabelle1.Cells(91, 380)).value = ""
Tabelle1.Unprotect Password:="passwort"
Range(Tabelle1.Cells(5, 15), Tabelle1.Cells(91, 380)).ClearComments
Tabelle1.Protect Password:="passwort", UserInterFaceOnly:=True
If userschicht = 1 Or userschicht = 10 Then
Range(Tabelle1.Cells(5, 15), Tabelle1.Cells(25, 380)).value = ""
Tabelle1.Unprotect Password:="passwort"
Range(Tabelle1.Cells(5, 15), Tabelle1.Cells(25, 380)).ClearComments
Tabelle1.Protect Password:="passwort", UserInterFaceOnly:=True
For a = 5 To 25
Stammnummer = Cells(a, 1).value
If Cells(a, 1).value <> 0 Then
Set User_auslesen = Datenbank.OpenRecordset("SELECT * FROM User WHERE Stammnummer=" & Cells(a, 1).value)
If User_auslesen.NoMatch Then
Else
For x = 15 To 381
If Cells(3, x).value = "" Then
Exit For
End If
Datum = Cells(3, x).value
Set Vorbelegung = Datenbank.OpenRecordset("SELECT * FROM Urlaubsplan WHERE Stammnummer=" & CStr(Stammnummer) & " AND Tag=" & CLng(Split(Datum, ".")(0)) & " AND Monat=" & CLng(Split(Datum, ".")(1)) & " AND Jahr=" & CLng(Split(Datum, ".")(2)), dbOpenDynaset)
Vorbelegung.FindFirst "Stammnummer=" & Stammnummer
If Vorbelegung.NoMatch Then
Else
Tabelle1.Cells(a, x).value = Vorbelegung.Fields("Schichtart").value
If Vorbelegung.Fields("letzter_Bearbeiter").value <> 0 Then
Set User_auslesen = Datenbank.OpenRecordset("SELECT * FROM User WHERE Stammnummer=" & Vorbelegung.Fields("letzter_Bearbeiter").value)
If User_auslesen.EOF Then
Else
User_auslesen.MoveFirst
If Vorbelegung.Fields("letzter_Bearbeiter").value <> "" Then
If Vorbelegung.Fields("Kommentar").value <> "" Then
If Vorbelegung.Fields("Kommentar_hervorheben").value = True Then
Kommentar = Vorbelegung.Fields("letzter_Bearbeiter").value & " - " & User_auslesen.Fields("Vorname").value & " " & User_auslesen.Fields("Familienname").value & Chr(10) & Vorbelegung.Fields("Zeitstempel").value & Chr(10) & Vorbelegung.Fields("Kommentar").value
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 3
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 3
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 3
End With
Else
Kommentar = Vorbelegung.Fields("letzter_Bearbeiter").value & " - " & User_auslesen.Fields("Vorname").value & " " & User_auslesen.Fields("Familienname").value & Chr(10) & Vorbelegung.Fields("Zeitstempel").value
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
End If
End If
Else
Kommentar = ""
End If
Tabelle1.Unprotect Password:="passwort"
If Tabelle1.Cells(a, x).Comment Is Nothing Then
Tabelle1.Cells(a, x).AddComment
Tabelle1.Cells(a, x).Comment.Shape.Locked = False
End If
Tabelle1.Cells(a, x).Comment.Visible = False
Tabelle1.Cells(a, x).Comment.text text:=Kommentar
With Tabelle1.Cells(a, x).Comment
.Shape.Height = 50
.Shape.Width = 150
End With
Tabelle1.Protect Password:="passwort", UserInterFaceOnly:=True
End If
End If
End If
Next x
End If
End If
Next a
End If
|