Office: Grafik mit Doppelklick einfügen

Hallo !

Ist es möglich, eine Grafik (Unterschrift) mit einem Doppelklick auf eine bestimmte Zelle an dieser Position einzufügen ? (Grafik ist größer als die Zelle, falls es eine Rolle spielt). Das ganze noch mit der Abhängigkeit, dass an anderer Stelle der dazugehörige Sachbearbeiter ausgewählt wurde ?
Die Grafik muss nicht unbedingt in der Datei enthalten sein, würde reichen, wenn diese aus einem Verzeichnis eingelesen wird.

Übrigens bei Excel 2003.

Vielen Dank im Voraus

doogie

 

Hallo Doogie,
das Ganze ist nur mit einem VBA-Makro möglich, das man am besten ins Klassen-Codemodul 'DieseArbeitsmappe' einfügt. Nachfolgend das Makro:

Code:

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  Dim Signatur$, Nutzer$
  Dim objOLE As OLEObject
  On Error GoTo Err_SheetBeforeDoubleClick
  
'---- Die User und ihre Unterschriftendateien werden ermittelt:
'---- In Zelladresse "A1" befindet sich der Hinweis auf den User (->anpassen!)

  Nutzer$ = Range("A1").Value 'statt "A1" Zelladresse des Sachbearbeiters angeben!!
  Select Case Nutzer$
     'Statt "User1" Sachbearbeiter1 angeben, statt "C:\....jpg" die Datei des Sachbearbeiters1 angeben.
   Case "User1": Signatur$ = "C:\Pfad\Signaturdatei1.jpg"
     'Statt "User2" Sachbearbeiter2 angeben, statt "C:\....jpg" die Datei des Sachbearbeiters2 angeben.
   Case "User2": Signatur$ = "c:\Pfad\Signaturdatei2.jpg"
   Case Else
     Signatur$ = "...": Err.Raise 9
  End Select
  
'---- Die Unterschriftengrafik wird an der Position
'     der aktiven Zelle als linken oberen Ecke eingeblendet.
  Set objOLE = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, _
    Left:=Target.Left, Top:=Target.Top, _
    Width:=300, Height:=190)
  With objOLE
    With .Object
      .Picture = LoadPicture(Signatur$)
      .PictureAlignment = 0 'TopLeft
      .PictureSizeMode = 3  'Zoom
      .BorderStyle = 0      'Kein Rand
      .BorderColor = RGB(255, 255, 255) 'weiß
      .MousePointer = 2     'Mauskreuz
      .AutoSize = True
    End With
  End With
  
Exit_SheetBeforeDoubleClick:
'--- OLE-Objekt wird freigegeben für Garbage-Collection
  Set objOLE = Nothing
  Exit Sub
  
Err_SheetBeforeDoubleClick:
'--- Falls die Unterschriftengrafik nicht gefunden werden konnte,
'    entferne das Grafikobjekt, melde den Fehler
  objOLE.Delete
  MsgBox Title:="FEHLENDE DATEI", _
         Prompt:="Die Datei '" & Signatur$ & "'" & vbCrLf & _
                 "für User '" & Nutzer$ & "' fehlt."
  Resume Exit_SheetBeforeDoubleClick
End Sub

An den bezeichneten Stellen (siehe Kommentare) das Makro an Deine Bedürfnisse anpassen. Ich bin von 2 Sachbearbeitern (User1, User2) ausgegangen, die in Zelle A1 enthalten sind.

Das Ganze macht nur dann einen Sinn, wenn die Excel-Datei mit dem Makro abgespeichert wird und diese gespeicherte Datei immer wieder als Vorlage eingelesen wird für die konkrete Arbeit der Sachbearbeiter und dann unter anderem Namen gespeichert wird.

Obwohl ich Excel2007 besitze, habe ich es auch unter Excel2003 getest.

Falls einmal eine Unterschrift an der falschen Stelle platziert wurde, so kann man die Grafik wieder löschen, wie folgt:
1) Die Mausleiste der Steuerelemente-Toolbox einblenden
2) Den Mausbutton für den Entwurfsmodus klicken, um ihn einzuschalten
3) Die Grafik anklicken, sodass sie selektiert ist
4) Die Taste 'Entf' drücken, um die Grafik zu löschen
5) Den Mausbutton für den Entwurfsmodus klicken, um ihn auszuschalten (darf keinesfalls vergessen werden !!)

 

Vielen Dank für die flotte Antwort, bin leider erst jetzt zum testen gekommen, hat mir auf jeden Fall sehr weitergeholfen !!