Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
604to608
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
604to608
604to608
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Werte in Kopfzeile eintragen

Werte in Kopfzeile eintragen
04.05.2005 16:40:22
Joerg
Hallo,
ich versuche verzweifelt, dass beim Audruck eines Berichtes in jeder Kopfzeile der Wert aus der Zelle "J11" steht. Das funktioniert auch soweit, jedoch wird der Ausdruck dadurch unglaublich verlangsamt.
PS: das

Sub Kopfzeile ist nur ein kleiner Teil der  abgearbeiteten Module, führt jedoch zu einer abnormen Verlangsamung des gesamten Vorganges
Wer kann helfen?
Danke Joerg
' Daten in Kopfzeile eintragen

Sub Kopfzeile()
nam = ActiveWorkbook.Name
Workbooks(nam).Activate
With ActiveSheet.PageSetup
.LeftHeader = Range("J11").Value
End With
End Sub

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Werte in Kopfzeile eintragen
04.05.2005 16:56:40
Peter
Servus,
Versuchs mal mit Application.DisplayAlerts = False am Anfang des Makros und = true am Ende des Makros.
Sonst kann ich ohne den Rest zu sehen wenig sagen.
MfG
Peter
AW: Werte in Kopfzeile eintragen
04.05.2005 17:12:50
Rudi
...oder meinst du Application.ScreenUpdating?
mfg Rudi
@rudi: hast natürlich recht, sry o.w.t.
04.05.2005 18:26:45
Peter
.
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
Anzeige
AW: Werte in Kopfzeile eintragen
04.05.2005 17:21:43
Fred
Hi,
PageSetup greift auf den Druckertreiber zu und das dauert eben.
mfg Fred
AW: Werte in Kopfzeile eintragen
04.05.2005 17:28:58
Joerg
Hallo,
der Hinweis auf Pagesetup leuchtet mir ein,
gibt es da keine andere Möglichkeit?
Gruss Joerg
AW: Werte in Kopfzeile eintragen
04.05.2005 17:47:59
Fred
Hi,
mir ist nixhts andes bekannt.
mfg Fred

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige