Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1784to1788
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
Inhaltsverzeichnis

In allen Blättern Logo in Kopfzeile

In allen Blättern Logo in Kopfzeile
09.10.2020 18:35:41
Pit
Hallo Experten / Expertinnen,
ich brauche mal wieder etwas Nachhilfe.
Ich möchte in allen Arbeitsblättern ein bestimmtes Logo in die Kopfzeile einfügen.
Folgenden Code habe ich aus verschiedenen Quellen zusammengebastelt (soll laufen in 'Diese Arbeitsmappe'):

Option Explicit
Private Sub Grafik_in_Kopfzeile()
Dim WSheet As Worksheet
' .Filename: Zellenbezug - Arbeitsblatt '*' Zelle 'B2' bzw. 'B4'
' .Height: Zellenbezug / Grafikhöhe in Pts (1/72 Zoll)
For Each WSheet In ActiveWorkbook.Worksheets
With WSheet.PageSetup
.Filename = [#!B2]
.LockAspectRatio = True
.Height = [#!B4]
End With
WSheet.PageSetup.RightHeader = "&G"
Next WSheet
End Sub

Ich habe verschiedene Änderungen probiert, was zu unterschiedlichen Fehlermeldungen geführ hat. Aber warum, das verstehe ich nicht. Wer kann mir den Mist vom Heu trennen helfen?
Vielen Dank schon jetzt!
Liebe Grüsse - Pit

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: In allen Blättern Logo in Kopfzeile
10.10.2020 12:30:53
Herbert_Grom
Hallo Pit,
probiers mal damit:
Sub Grafik_in_Kopfzeile()
Dim iSheetsCount%
For iSheetsCount = 1 To Sheets.Count
With Sheets(iSheetsCount).PageSetup.RightHeaderPicture
.Filename = Sheets(iSheetsCount).Range("B2")
.LockAspectRatio = True
.Height = Sheets(iSheetsCount).Range("B4")
End With
Sheets(iSheetsCount).PageSetup.RightHeader = "&G"
Next iSheetsCount
End Sub
Servus
AW: In allen Blättern Logo in Kopfzeile
12.10.2020 10:23:41
Pit
Hallo Herbert,
vielen Dank für deinen Vorschlag. Ich habe deinen Code eingegeben, was zu einem 'Modul1' geführt hat, bisher habe ich im Bereich 'Diese Arbeitsmappe' probiert.
Beim Laufen des Makros erscheint eine Fehlermeldung 'Laufzeitfehler 13'. Ich habe an der Zeile herumgebastelt, doch damit habe ich bloss eine andere Fehlermeldung '1004' erhalten.
Zeile ursprünglich:

.LockAspectRatio = True

Zeile verändert:

.LockAspectRatio = Sheets(iSheetsCount).Range("True")

Auch gibt es ein Problem mit der Adressierung des Arbeitsblatts mit den Zellen: ...Range("#!B2") ergibt auch eine Fehlermeldung. Es wäre das Arbeitsblatt '#' mit den Zellen 'B2' und 'B4'.

Option Explicit
Sub Grafik_in_Kopfzeile()
Dim iSheetsCount%
' .Filename: Zellenbezug - Arbeitsblatt '#' Zelle 'B2' bzw. 'B4'
' .Height: Zellenbezug / Grafikhöhe in Pts (1/72 Zoll)
For iSheetsCount = 1 To Sheets.Count
With Sheets(iSheetsCount).PageSetup.RightHeaderPicture
.Filename = Sheets(iSheetsCount).Range("B2")
.LockAspectRatio = Sheets(iSheetsCount).Range("True")
.Height = Sheets(iSheetsCount).Range("B4")
End With
Sheets(iSheetsCount).PageSetup.RightHeader = "&G"
Next iSheetsCount
End Sub

So bitte ich um weitere Unterstützung, besten Dank. :-)
Liebe Grüsse - Pit
Anzeige
AW: In allen Blättern Logo in Kopfzeile
12.10.2020 12:46:03
Pit
Hallo Herbert,
vielen Dank für deinen Vorschlag. Ich habe deinen Code eingegeben, was zu einem 'Modul1' geführt hat, bisher habe ich im Bereich 'Diese Arbeitsmappe' probiert.
Beim Laufen des Makros erscheint eine Fehlermeldung 'Laufzeitfehler 13'. Ich habe an der Zeile herumgebastelt, doch damit habe ich bloss eine andere Fehlermeldung '1004' erhalten.
Zeile ursprünglich:

.LockAspectRatio = True

Zeile verändert:

.LockAspectRatio = Sheets(iSheetsCount).Range("True")

Auch gibt es ein Problem mit der Adressierung des Arbeitsblatts mit den Zellen: ...Range("#!B2") ergibt auch eine Fehlermeldung. Es wäre das Arbeitsblatt '#' mit den Zellen 'B2' und 'B4'.

Option Explicit
Sub Grafik_in_Kopfzeile()
Dim iSheetsCount%
' .Filename: Zellenbezug - Arbeitsblatt '#' Zelle 'B2' bzw. 'B4'
' .Height: Zellenbezug / Grafikhöhe in Pts (1/72 Zoll)
For iSheetsCount = 1 To Sheets.Count
With Sheets(iSheetsCount).PageSetup.RightHeaderPicture
.Filename = Sheets(iSheetsCount).Range("B2")
.LockAspectRatio = Sheets(iSheetsCount).Range("True")
.Height = Sheets(iSheetsCount).Range("B4")
End With
Sheets(iSheetsCount).PageSetup.RightHeader = "&G"
Next iSheetsCount
End Sub

So bitte ich um weitere Unterstützung, besten Dank. :-)
Liebe Grüsse - Pit
Anzeige
AW: In allen Blättern Logo in Kopfzeile
12.10.2020 16:15:44
Herbert_Grom
Hallo Pit,
da es bei mir läuft, kann ich ohne die Originaldatei nicht sagen, woran das liegen könnte!
Servus
P.S.: Es wird hier im Forum nicht gerne gesehen, wenn man, vor lauter Ungeduld, einen weiteren Thread, mit dem gleichen Thema, aufmacht!
AW: In allen Blättern Logo in Kopfzeile
12.10.2020 17:08:08
Pit
Hallo Herbert,
vielen Dank für deine Rückmeldung, ich probiere es nochmals. Übrigens war das mit dem doppelten Eintrag ein Versehen und keine Ungeduld. Löschen kann ich einen nicht gewollten Eintrag wohl nicht, ich habe auf jeden Fall keine Funktion dazu gefunden...
Ich habe (noch) etwas Mühe mit dem Erstellen und Beantworten von Beiträgen :-|
Liebe Grüsse - Pit
Anzeige
AW: In allen Blättern Logo in Kopfzeile
12.10.2020 17:14:23
Herbert_Grom
Hallo Pit,
warum hast du meine Zeile
.LockAspectRatio = True
so abgeändert?
.LockAspectRatio = Sheets(iSheetsCount).Range("True")
Das funktioniert bei mir auch nicht!
Außerdem habe ich jetzt festgestellt, dass er da nur "jpg"-Grafiken akzeptiert, jedenfalls keine "png"! Ich hänge dir mal meine Excel-Datei und die 4 Grafiken an, dann kannst du mal damit testen. Bei mir hat das funktioniert! Den Pfad musst du natürlich anpassen!
https://www.herber.de/bbs/user/140835.xlsm
Servus
Anzeige
AW: In allen Blättern Logo in Kopfzeile
15.10.2020 14:08:13
Pit
Hallo Herbert,
zurück von meinem Aussendiensteinsatz und heureka! Vielen Dank für deine Beispieldatei, nun habe ich den Fehler bei mir auch finden können. VBA gibt bei mir den Fehlercode '1004' zurück - weil ich bei der Pfadangabe zur Grafikdatei einen Fehler hatte! Und ich dachte immer, es liege am Code. Grmbl...
Nun klappts, besten Dank!
Liebe Grüsse - Pit
AW: Gerne geschehen und danke für die Rückmeldung!
15.10.2020 15:04:06
Herbert_Grom
,,,

308 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige