Tabellenbereich in Excel als Bild kopieren
#1
Photo 
Hallo zusammen,

ich stecke gerade in einer Aufgabe fest und komme nicht mehr weiter. Ich hoffe, dass jemand von euch mir hier weiterhelfen kann.

Da meine Kenntnisse in Makros nur dürtig sind hoffe ich mit eurer Hilfe das Problem zu lösen.

Folgendes Szenario:

Ich möchte die Erstellung eines Dokuments in einer gewissen Art automatisieren.
Bisher ist der Ablauf so, dass ich in jedes Worksheet reingehe und die Tabelle bzw den Bereich Markiere und als "Bild - wie gedruckt" kopiere, anschliessend füge ich das Bild in einer Worddatei ein.
Da man dieses Dokument relativ oft mit den neusesten Daten erneuert muss der Vorgang auch relativ oft wiederholt werden.

Nun habe ich gedacht, dass sich dies über die Macro-Funktion in Word und Excel sicherlich automatisieren lässt.

Mit einigen Codeschnippsel aus diversen Foren konnte ich bis jetzt folgendes erreichen.

1) Ich kann in ein gewünschtes Worksheet reingehen und den Bereich den ich möchte als ein Bild kopieren und in einem Ordner, welchen Pfad ich angegeben habe einfügen.
dies Erreiche ich mit diesem Code:

Sub knzDE()
Dim ws As Worksheet
Set ws = Worksheets("Kennzahlen DE")
Dim g As Shape
 Application.ScreenUpdating = False
   ws.Range("A10:K10:A30").CopyPicture Appearance:=xlPrinter
   With ActiveSheet.ChartObjects.Add(0, 0, Range("A10:K10").Width, Range("A10:A30").Height).Chart
      .Paste
      .Export "PfadXXX\KNZ_DE.jpg"
      .Parent.Delete
   End With
   Application.ScreenUpdating = True
End Sub

Dies Makro macht eigentlich genau das was ich will. Ob es elegantere Lösungen gibt kann ich leider nicht beurteilen, weil mir dazu das Wissen fehl.

2) In einem zweiten Schritt füge ich das zuvor kopierte Bild an einer von mir definierten Stelle im Worddokument ein.
dies erziele ich indem ich folgendes Makto in Word absetze

Sub InsertImages()
    With ActiveDocument
        Selection.Find.ClearFormatting
        With Selection.Find
            .Forward = True
            .Text = "KZ_DE"
            .Replacement.Text = ""
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        If Selection.Find.Execute Then
            Selection.InlineShapes.AddPicture FileName:= _
            "PfadXXX\KNZ_DE.jpg", LinkToFile:=False, _
            SaveWithDocument:=True
            Selection.Find.Wrap = wdFindContinue
        End If

Das Makro ansich funktioniert auch so wie ich es mir vorgestellt habe.

Mein eigentliches Problem ist nun, dass die Qualität der Grafik sehr schlecht ist. Und ich bekomme eine Art Rahmen um die Grafik herum. Als ich das manuell noch erstellt habe, ist die Qualität der Grafik hervorragend gewesen und es hat keinen Rand um den markierten Bereich gegeben. (im Anhang habe ich die Grafik angehängt, da kann man auch den dünnen Rahmen des Bildes sehen)

Deshalb meine Frage an euch. Hat jemand eine Idee wie ich diese Problem lösen könnte?

Ich wäre euch Für jede Hilfe oder Tipp dankbar.

Grüssli
Zivi
Top
#2
Hallo,

eine ähnliche Frage wird gerade in einem Nachbar-Forum diskutiert:

http://office-loesung.de/p/viewtopic.php?f=166&t=734662

Teilweise sind die Vorschläge "etwas kompliziert".

mfg
Top
#3
Hallöchen,

Du könntest für die Qualität mal die andere Einstellung versuchen:
ws.Range("A10:K10:A30")..CopyPicture xlScreen, xlBitmap

Man könnte die Zwischenablage dann auch direkt nach Word übernehmen. Dazu musst DU Dir erst mal Word "rüberholen"
Set objWordApp = GetObject(, "Word.Application")

und dann das Document schnappen und die Grafik aus der Zwischenablage einfügen.
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste