Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1260to1264
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Pro Tabelle, Range kopieren und als jpg speichern

Pro Tabelle, Range kopieren und als jpg speichern
Mandy
Hallo,
ich habe eine Mappe mit vielen Tabellenblättern. Alle Tabellenblätter, die ich per VBA bearbeiten will, beginnen namentlich immer mit "Vorgang XXXX" und alle sind gleich strukturiert.
Nun würde ich gerne mit einer Schleife (wenn das geht) alle Tabellenblätter durchlaufen, die mit "VORGANG" beginnen und dort jeweils vom Range "A2:N10" eine Grafik des Ranges erstellen und jede Grafik als jpg oder gif abspeichern.
Als Grafikname könnte jeweils der aktuelle Blattname dienen. Am besten wäre es, wenn der Code alle Grafiken ungefragt (ohnen Bestätigung) nacheinander speichert.
Hat da jemand eine Idee, wie man das machen könnte ?
Vielen Dank
Mandy

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Pro Tabelle, Range kopieren und als jpg speichern
07.05.2012 16:26:39
xr8k2
Hallo Mandy,
ich greif mal die Lösung vom Sepp auf:
https://www.herber.de/forum/archiv/1128to1132/t1130567.htm#1130577
Das ganze noch mit einer Schleife über deine Tabellenblätter versehen und voilá:
Option Explicit
Sub Range_To_Image()
Dim objPict As Object, objChrt As Chart
Dim rngImage As Range, strFile As String
Dim Tabelle As Worksheet
On Error GoTo ErrExit
For Each Tabelle In ThisWorkbook.Worksheets
With Tabelle
If Left(.Name, 7) = "Vorgang" Then
Set rngImage = .Range("A1:C20")
rngImage.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
Set objPict = .Shapes(.Shapes.Count)
strFile = "C:\DeinOrdner\" & Tabelle.Name & ".jpg" 'Pfad anpassen!
objPict.Copy
Set objChrt = .ChartObjects.Add(1, 1, objPict.Width + 8, objPict.Height + 8).Chart
objChrt.Paste
objChrt.Export strFile
objChrt.Parent.Delete
objPict.Delete
End If
End With
Next Tabelle
ErrExit:
Set objPict = Nothing
Set objChrt = Nothing
Set rngImage = Nothing
End Sub
Mit freundlicher Unterstützung von Josef Ehrensberger!
Gruß,
xr8k2
Anzeige
Sorry, habe mich noch gar nicht bedankt ..
10.05.2012 11:29:59
Mandy
HI,
mach ich miermit :-)
Danke
Gruß
Mandy

316 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige