Microsoft Excel

Herbers Excel/VBA-Archiv

In allen Blättern Logo in Kopfzeile

Betrifft: In allen Blättern Logo in Kopfzeile von: Pit
Geschrieben am: 09.10.2020 18:35:41

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

Betrifft: AW: In allen Blättern Logo in Kopfzeile
von: Herbert_Grom
Geschrieben am: 10.10.2020 12:30:53

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

Betrifft: AW: In allen Blättern Logo in Kopfzeile
von: Pit
Geschrieben am: 12.10.2020 10:23:41

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

Betrifft: AW: In allen Blättern Logo in Kopfzeile
von: Pit
Geschrieben am: 12.10.2020 12:46:03

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

Betrifft: AW: In allen Blättern Logo in Kopfzeile
von: Herbert_Grom
Geschrieben am: 12.10.2020 16:15:44

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!

Betrifft: AW: In allen Blättern Logo in Kopfzeile
von: Pit
Geschrieben am: 12.10.2020 17:08:08

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

Betrifft: AW: In allen Blättern Logo in Kopfzeile
von: Herbert_Grom
Geschrieben am: 12.10.2020 17:14:23

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

Betrifft: AW: In allen Blättern Logo in Kopfzeile
von: Herbert_Grom
Geschrieben am: 12.10.2020 17:15:50

und hier die 4 Grafiken!

https://www.herber.de/bbs/user/140836.zip

Betrifft: AW: In allen Blättern Logo in Kopfzeile
von: Pit
Geschrieben am: 15.10.2020 14:08:13

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

Betrifft: AW: Gerne geschehen und danke für die Rückmeldung!
von: Herbert_Grom
Geschrieben am: 15.10.2020 15:04:06

,,,