PDF als Objekt einfügen und Icon skalieren

[MPK-RT]

Hallo zusammen,
 
Ich versuche zur Zeit ein Makro zu basteln, mit dem ich ein Objekt (pdf etc.) als Icon einbinden kann und sich dieses dynamisch an die Zellengröße anpasst. Leicht gedacht, schwer umgesetzt. Ich komm leider keinen Schritt weiter. Das einfügen des Objektes als Icon ist kein Problem, jedoch gestaltet sich die Umsetzung des automatischen Skalierens des Icons an die Zellenhöhe für mich als unlösbar.
 
Ich hoffe ihr könnt mir weiterhelfen.
 
Hier ist noch der aktuelle Code:

Code:

Sub Objekt_einfügen()
'Makro Objekt einfügen


'Gewünschte Zelle auswählen

On Error GoTo MyErrHndl
  Dim myQ As Range, myC As Range
Dim myTarget As Range
Dim stRow As Integer, endRow As Integer
stRow = Selection.Row
endRow = 1
Set myQ = Selection
Set myTarget = Application.InputBox("An welcher Stelle Soll das Bild eingefügt werden ?", "Zielzelle wählen", Type:=8)
If Not myTarget Is Nothing Then
    For Each myC In myQ
        If myC.Row > endRow Then
            endRow = myC.Row
        End If
    Next

myTarget.Select

'Objekt einfügen


    Set Object = ActiveSheet.OLEObjects.Add(ClassType:="AcroExch.Document.7", Link:=False, _
        DisplayAsIcon:=True, IconFileName:= _
       "C:\Windows\Installer\{AC76BA86-7AD7-FFFF-7B44-AA0000000001}\PDFFile_8.ico", _
        IconIndex:=0, IconLabel:="Adobe Acrobat Document").Activate
    With Object
        .Height = myTarget.Height * tmpHeight
        .Width = myTarget.Width * tmpWidth
        .Top = myTarget.Top
        .Left = myTarget.Left
        .Placement = xlMoveAndSize
    End With
    Set Object = Nothing
    
    
     End If
MyErrHndl:

End Sub

Danke im Voraus!

Gruß,

Flo

[Jockel]

Hallo, hier hat jemand ein ganz ähnliches Problem...:

http://www.office-loesung.de/p/viewtopic.php?f=166&t=712199&sid=6d7ec4f6fb60c1b6d04792a54d7d940c

[GMG-CC]

... nicht nur da, scheinbar Gießkannen-Prinzip :@ . -> Hier auch

Crossposting ohne gegenseitige Verweise ist einfach nur egoistisch und Mist!

[MPK-RT]

Hallo Jockel und GMG-CC,

es tut mir leid, wenn ich euch dadurch verärgert habe.

Ich suche seit mehreren Tagen nach dem Problem in den verschiedensten Foren und erhoffte mir durch die "Streuung" eine sichere Antwort. 
Wenn mir in einem der Foren geholfen werden kann, werde ich das in den anderen natürlich mitteilen.

Könnt ihr mir bei dem Problem helfen?

Grüße

[WillWissen]

Hi,

dann solltest du aber fairerweise die Foren untereinander verlinken, damit sich die Helfer ein Bild machen können, was im jeweils anderen Forum diskutiert wird und wie weit ein Lösungsansatz eventuell fortgeschritten ist.

[MPK-RT]

Hallo zusammen,

habe jetzt in den anderen Foren auf diesen Beitrag verwiesen.

Hoffe das ist jetzt ok so.
Hab daraus gelernt, wird nicht mehr passieren.

Kann mir jemand bei meinem Problem helfen?


Grüße
Flo

[atilla]

Hallo Flo,

ist das der Ganze Code?


Die Variablen tmpHeight und tmpWidth sind nicht belegt und haben den Wert 0, so dass die Höhe und Brei 0 ist.

Lösch beide und das Activate in der Zeile beim Einfügen.

insgesmat mal so teste:

Code:

Sub Objekt_einfügen()
'Makro Objekt einfügen


'Gewünschte Zelle auswählen

'On Error GoTo MyErrHndl
 Dim myQ As Range, myC As Range
Dim myTarget As Range
Dim stRow As Integer, endRow As Integer
stRow = Selection.Row
endRow = 1
Set myQ = Selection
Set myTarget = Application.InputBox("An welcher Stelle Soll das Bild eingefügt werden ?", "Zielzelle wählen", Type:=8)
If Not myTarget Is Nothing Then
   For Each myC In myQ
       If myC.Row > endRow Then
           endRow = myC.Row
       End If
   Next

myTarget.Select

'Objekt einfügen


   Set Object = ActiveSheet.OLEObjects.Add(ClassType:="AcroExch.Document.7", Link:=False, _
       DisplayAsIcon:=True, IconFileName:= _
      "C:\Windows\Installer\{AC76BA86-7AD7-FFFF-7B44-AA0000000001}\PDFFile_8.ico", _
       IconIndex:=0, IconLabel:="Adobe Acrobat Document")
   With Object
       .Height = myTarget.Height
       .Width = myTarget.Width
       .Top = myTarget.Top
       .Left = myTarget.Left
       .Placement = xlMoveAndSize
   End With
   Set Object = Nothing
   
   
    End If
MyErrHndl:

End Sub

[Jockel]

Hallo zusammen,

habe jetzt in den anderen Foren auf diesen Beitrag verwiesen.

...

Grüße
Flo

Hallo Flo, ist das so..? (Das reimt sich so schön)

http://www.office-hilfe.com/support/show...-skalieren

[MPK-RT]

Hallo zusammen,

habe jetzt in den anderen Foren auf diesen Beitrag verwiesen.

...

Grüße
Flo

Hallo Flo, ist das so..? (Das reimt sich so schön)

http://www.office-hilfe.com/support/show...-skalieren

Ja eigentlich habe ich auch in diesem Forum geschrieben:

"Es tut mir leid, habe "Crossposting" betrieben und die Beiträge nicht verlinkt.


Hier wird auch über das Thema gesprochen.
http://www.clever-excel-forum.de/Thread ... -skalieren

Grüße
Flo  "

Als Bestätigung kam "Vielen Dank für deinen Beitrag! Dein Beitrag wird bald von einem Moderator überprüft und freigeschaltet werden. "

Und das ist wohl noch nicht geschehen...

Gruß
Flo

[MPK-RT]

Hallo Atilla,

Vielen Dank für deine Antwort,
es funktioniert leider nicht. Er bricht ab bei

Code:

Set Object = Acti....

der eigentliche code zum einbinden der PDF ist:

Code:

  ActiveSheet.OLEObjects.Add(ClassType:="AcroExch.Document.11", Link:=False, _
        DisplayAsIcon:=True, IconFileName:= _
        "C:\Windows\Installer\{AC76BA86-7AD7-1031-7B44-AB0000000001}\PDFFile_8.ico", _
        IconIndex:=0, IconLabel:="Adobe Acrobat Document").Activate

Das funktioniert so weit auch ganz gut.

Jetzt steh ich aber vor dem Problem, dass ich den Icon an die Zellgröße anpassen will (es ist kein Problem, wenn er danach "verzerrt" ist)

Und hier weis ich nicht mehr weiter.


Gruß
Flo