Bilder übernehmen

Ralf · 2023-02-19T08:05:45+00:00

Guten morgen alle zusammen, Ich hätte da mal eine Frage. Ich arbeite mit mehrere Partner die alle den gleichen Vordruck ( Excel-Datei ) verwenden, jedoch jeder sein eigenes Logo hat. Momentan kopiere ich das Logo jedes mal manuell in den Vordruck. Gibt es da vielleicht eine Möglichkeit, das durch ein Wort ( z.B. ABC ) das passende Logo an eine vorher bestimmte Position im Vordruck hochgeladen wird, so das ich dann den kompletten Vordruck in PDF wandeln kann. Ich stelle mir vor das ich in einer Tabelle in der Zelle B2 den Namen habe ( ABC ) und in der Zelle C2 dann das passende Logo habe usw. Im Vordruck habe ich dafür eine feste Zelle vorgesehen. Ich würde m ich freuen, wenn jemand da eventuell eine IDEE hätte Gruß Ralf

Hallo Ralf,
natürlich lässt sich das Logo von irgendwoher kopieren oder gar aus einer Datei importieren...
Vorab vielleicht eine andere Idee. Setze alle Logos an die vorgesehene Stelle im Vordruck und blende alle Logos aus, bis auf das jeweils gewünschte.
Da kann man sich das Kopieren und das Löschen des bisherigenLogos (denn das müsstest Du ja auch machen) sparen.
Idee: Wenn Du den Code in die Open-Funktion der Arbeitsmappe legst könntest Du auch die Logos so nennen, wie die Usernamen der Nutzer sind. Dann hat jeder immer sein eigenes Logo.
Hier ein Beispiel-Code:

Code:


Private Sub Workbook_Open()
  Dim oShp As Object
  
  For Each oShp In Sheets("Tabelle1").Shapes
      oShp.Visible = oShp.Name Like Sheets("Tabelle1").Range("B2").Value
'     oShp.Visible = oShp.Name =Environ("Username")
  Next oShp
End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

Hallo Ralf,
hier ein Makro, welches das entsprechende Logo austauscht, sobald man in R1 einen anderen Kunden auswählt.
Die Variante ist ggü. meines vorherigen Vorschlags ist allerdings umfangreicher.
Um die Grafiken nicht benennen zu müssen, werden sie anhand ihrer Position in einer Schleife gesucht. Kann man natürlich auch anders gestalten.
Bzgl. der Position und der Größe habe ich noch entsprechenden Code mit aufgenommen.
Probiere es halt mal aus....
Logo_Wechseln.xlsm

Code:


Option Explicit

Sub Logo_Wechseln()
  Dim WSh As Worksheet, oShape As Object
  Dim vGefunden As Variant
  
  Set WSh = ThisWorkbook.Sheets("Datenblatt")
  
' Bild suchen und kopieren
  With ThisWorkbook.Sheets("Logos")
      vGefunden = Application.Match(WSh.Range("R1").Value, .Columns(1), 0)
      If IsError(vGefunden) Then Exit Sub
      For Each oShape In .Shapes
          If oShape.TopLeftCell.Address = .Cells(vGefunden, "B").Address Then
             oShape.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
             DoEvents: Exit For
          End If
      Next oShape
  End With

' Bild einfügen, vorher altes löschen
  WSh.Select
  WSh.Unprotect                                     ' Blatt entschützen
  On Error Resume Next
  WSh.Shapes.Range("Logobild").Delete               ' Altes Bild löschen
  ActiveSheet.Paste                                 ' Neues Bild einfügen
  With Selection
     .Name = "Logobild"
     .Width = 130                                   ' Mit Größe und Position spielen...
     .Top = WSh.Range("I2").Top + 2
     .Left = WSh.Range("I2").Left + 110
  End With
  Range("A1").Select
  WSh.Protect                                       ' Blatt schützen

End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

Forumthread: Bilder übernehmen

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Bilder übernehmen

Forumthread: Bilder übernehmen

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread