AW: Werte in Kopfzeile eintragen
04.05.2005 17:17:22
Joerg
Hallo,
danke für Deine Antwort, leider führt dies zu keiner Verbesserung, ich habe noch mal das ganze Worksheet mit dazukopiert, ich befürchte nur, das es sehr unübersichtlich ist und bin niemanden böse, wenn er die Frage ignoriert.
Und wie gesagt, die Verlangsamung kommt erst durch das Einfügen der folgenden Zeilen
zustande.
nam = ActiveWorkbook.Name
Workbooks(nam).Activate
With ActiveSheet.PageSetup
.LeftHeader = Range("J11").Value 'oder inh mit obiger Schleife
End With
Gruss Joerg
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
' Patientendaten in Kopfzeile eintragen
'Sub Kopfzeile()
'Dim r%, inh As String, nam As String
nam = ActiveWorkbook.Name
'For r = 11 To 13 'komplett bis 16
' inh = inh & Cells(r, 2) & Chr(13)
'Next r
Workbooks(nam).Activate
With ActiveSheet.PageSetup
.LeftHeader = Range("J11").Value 'oder inh mit obiger Schleife
End With
'End Sub
Range("A1:A843").EntireRow.Hidden = False
' sub Zeilen verschwinden wenn leer
' Diagnosen, Operationen, Medikamente
Dim Diagnosen As Range
For Each Diagnosen In Range("F26:F116")
If Diagnosen.Value = "" Or Diagnosen.Value = "0" Then
Diagnosen.EntireRow.Hidden = True
End If
Next Diagnosen
For Each Diagnosen In Range("H119:H123")
If Diagnosen.Value = "" Or Diagnosen.Value = "0" Then
Diagnosen.EntireRow.Hidden = True
End If
Next Diagnosen
'Farbänderung bei pausierten Medikamenten
For I = 71 To 85
If Cells(I, 27).Value = "pausiert !!!" Then
Range(Cells(I, 15), Cells(I, 24)).Font.ColorIndex = 2
Range(Cells(I, 6), Cells(I, 13)).Font.ColorIndex = 1
Range(Cells(I, 6), Cells(I, 13)).Font.Size = 8
Else: Range(Cells(I, 6), Cells(I, 24)).Font.ColorIndex = 11
Range(Cells(I, 6), Cells(I, 14)).Font.Size = 10
End If
Next
Range("A9").EntireRow.Hidden = True
Range("A16:A17").EntireRow.Hidden = True
Range("A22").EntireRow.Hidden = True
Range("A29:A32").EntireRow.Hidden = False
Range("A43:A46").EntireRow.Hidden = False
Range("A53:A56").EntireRow.Hidden = False
Range("A67:A70").EntireRow.Hidden = False
Range("A86:A90").EntireRow.Hidden = False
Range("A98:A101").EntireRow.Hidden = False
Range("A111:A114").EntireRow.Hidden = False
Range("A121").EntireRow.Hidden = False
' Perfusoren verschwinden
If Cells(91, 6).Value = "" And Cells(92, 6).Value = "" And Cells(93, 6).Value = "" And Cells(94, 6).Value = "" And Cells(95, 6).Value = "" And Cells(96, 6).Value = "" And Cells(97, 6).Value = "" Then
Range("A87:A90").EntireRow.Hidden = True
Range("A98").EntireRow.Hidden = True
End If
'Schmerztherapie verschwindet
If Cells(115, 6).Value = "" And Cells(116, 6).Value = "" Then
Range("A112:A117").EntireRow.Hidden = True
End If
'Magensondenernährung verschwindet
If Cells(126, 8).Value = "" Then
Range("Q126").Font.ColorIndex = 2
Else: Range("Q126").Font.ColorIndex = 11
End If
'bei Antikörpern pos. --> herausheben
If Cells(122, 15).Value = "AK pos." Then 'Zelle 122;O
Cells(122, 15).Font.Bold = True
Cells(122, 15).Font.ColorIndex = 3
Else: Cells(122, 15).Font.ColorIndex = 11
Cells(122, 15).Font.Bold = False
End If
' Verlauf_kuerzen
Dim Verlauf As Range
For Each Verlauf In Range("H337:H835")
If Verlauf.Value = "" Or Verlauf.Value = "0" Then
Verlauf.EntireRow.Hidden = True
End If
Next Verlauf
Dim VerlaufDaten As Range
For Each VerlaufDaten In Range("D337:D835")
If VerlaufDaten.Value = "" Or VerlaufDaten.Value = "0" Then
VerlaufDaten.Font.ColorIndex = 2 'schriftfarbe weiss
Else: VerlaufDaten.Font.ColorIndex = 11
End If
Next VerlaufDaten
Dim VerlaufHandzeichen As Range
For Each VerlaufHandzeichen In Range("AG337:AH835")
If VerlaufHandzeichen.Value = "" Or VerlaufHandzeichen.Value = "0" Then
VerlaufHandzeichen.Font.ColorIndex = 2 'schriftfarbe weiss
Else: VerlaufHandzeichen.Font.ColorIndex = 11
End If
Next VerlaufHandzeichen
'Verlauf Röntgen und Hygiene kürzen
Dim Röntgenbefund As Range
For Each Röntgenbefund In Range("M131:M229")
If Röntgenbefund.Value = "" Or Röntgenbefund.Value = "0" Then
Röntgenbefund.EntireRow.Hidden = True
Else: Röntgenbefund.Font.ColorIndex = 11
End If
Next Röntgenbefund
Dim Röntgendatum As Range
For Each Röntgendatum In Range("D131:D229")
If Röntgendatum.Value = "" Or Röntgendatum.Value = "0" Then
Röntgendatum.Font.ColorIndex = 2
Else: Röntgendatum.Font.ColorIndex = 11
End If
Next Röntgendatum
Dim Röntgenuntersuchung As Range
For Each Röntgenuntersuchung In Range("H131:H229")
If Röntgenuntersuchung.Value = "" Or Röntgenuntersuchung.Value = "0" Then
Röntgenuntersuchung.Font.ColorIndex = 2
Else: Röntgenuntersuchung.Font.ColorIndex = 11
End If
Next Röntgenuntersuchung
Dim Hygienebefund As Range
For Each Hygienebefund In Range("M234:M332")
If Hygienebefund.Value = "" Or Hygienebefund.Value = "0" Then
Hygienebefund.EntireRow.Hidden = True
Else: Hygienebefund.Font.ColorIndex = 11
End If
Next Hygienebefund
Dim Hygienedatum As Range
For Each Hygienedatum In Range("D234:D332")
If Hygienedatum.Value = "" Or Hygienedatum.Value = "0" Then
Hygienedatum.Font.ColorIndex = 2
Else: Hygienedatum.Font.ColorIndex = 11
End If
Next Hygienedatum
Dim Hygieneuntersuchung As Range
For Each Hygieneuntersuchung In Range("H234:H332")
If Hygieneuntersuchung.Value = "" Or Hygieneuntersuchung.Value = "0" Then
Hygieneuntersuchung.Font.ColorIndex = 2
Else: Hygieneuntersuchung.Font.ColorIndex = 11
End If
Next Hygieneuntersuchung
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub