Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1036to1040
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

Abspeichern Tabellenblatt über CommandButton

Abspeichern Tabellenblatt über CommandButton
09.01.2009 01:22:33
MobyDick
Hallo ihr Nachstschwärmer,
ich habe eine Frage:
Ich habe zwei Diagramme auf dem vierten Tabellenblatt zusammengeführt, die sich aus vorigen Berechnungen ergeben haben. Jetzt würde ich gerne mit Hilfe eines CommandButtons die Ergebnisse in ein neues .xls-file abspeichern.
Gibt es ein VBA-Befehl zum Abspeichern? Leider kann ich ja nicht nur das vierte Tabellenblatt in ein neues .xls-file abspeichern, da ja die Tabellen sich auf Werte aus den vorigen Blättern beziehen, oder !?
Kann man mit VBA auch ein Screenshot der Tabelle4 machen und sich das vielleicht in einem .jpg-Format abspeichern lassen?
Sorry für die abgefahrenen Fragen, um eine Antwort wäre ich Euch sehr dankbar. Ansonsten wünsche ich eine gute Nacht!

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Abspeichern Tabellenblatt über CommandButton
09.01.2009 09:59:58
fcs
Hallo MobyDick,
du kannst das Blatt mit den Diagrammen in eine neue Mappe kopieren und dann die Verknüpfungen zur Quelldatei löschen. Dabei werden dann Formeln durch Werte ersetzt.
Nach folgend ein entsprechendes Makro, dass du ggf. noch etwas anpassen muss.
Gruß
Franz

Sub DiagrammAuslagern()
' DiagrammAuslagern Makro - Erstellt mit Excel 2003
Dim wksDiagramm As Worksheet
Dim wbThis As Workbook, wbDiag As Workbook
Dim intI As Integer
Dim astrLinks As Variant
Set wbThis = ThisWorkbook
Set wksDiagramm = wbThis.Worksheets("Tabelle4")
'Diagrammblatt in neue Datei kopieren
wksDiagramm.Copy
Set wbDiag = ActiveWorkbook
'Ausgelagertes Diagrammblatt speichern
wbDiag.SaveAs Filename:=wbThis.Path & "\" _
& "Diagramm " & Format(Now, "YYYYMMDD hhmmss") & ".xls", _
FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False, AddToMRU:=True
'Link(s) zur Quelldatei entfernen (ersetzt Formeln durch Werte)
astrLinks = wbDiag.LinkSources(Type:=xlLinkTypeExcelLinks)
For intI = LBound(astrLinks) To UBound(astrLinks)
wbDiag.BreakLink _
Name:=astrLinks(intI), _
Type:=xlLinkTypeExcelLinks
Next
wbDiag.Save
wbDiag.Close
End Sub


Anzeige
AW: Abspeichern Tabellenblatt über CommandButton
10.01.2009 14:50:43
MobyDick
Hallo Franz,
ich habe dein SuperMakro eingefügt und wenn ich jetzt dieses ablaufen lasse, so wird zwar das Worksheet exportiert in die neue .xls-Datei "Dagramme", aber VBA schaltet sich ein und sagt, dass das Objekt diese Eigenschaft oder Methode nicht unterstützt. Die Datei befindet sich abgespeichert im selben Ordner wie die Quelldatei. Aber ich die neu erzeugte Datei "Diagramme" wird nicht mehr geschlossen, wie es das Makro befielt!?
Ich wünschte mir, es würde schon funktionieren. Ich danke Dir vielmals für deine bereits erbrachte Hilfe!
Viele Grüße, MobyDick
AW: Abspeichern Tabellenblatt über CommandButton
12.01.2009 10:46:00
fcs
Hallo MobyDick,
das Entfernen der Verknüpfung funktionierte bei mir auch nicht auf Anhieb. So stürzte Excel bei dem per Rekorder aufgezeichneten Code sogar ständig ab.
Meine Lösung funktioniert in meiner Test-Datei reibungslos.
Ich hab das Makro jetzt um eine Fehlerbehandlung erweitert. So sollte es zumindest mit Fehlermeldungen durchlaufen.
Hier meine Testdatei. Probier mal ob die bei dir auch funktioniert.
https://www.herber.de/bbs/user/58299.xls
Gruß
Franz

Sub DiagrammAuslagern()
' Modifiziert 2009-01-12
' DiagrammAuslagern Makro - Erstellt mit Excel 2003
Dim wksDiagramm As Worksheet
Dim wbThis As Workbook, wbDiag As Workbook
Dim intI As Integer
Dim astrLinks As Variant
On Error GoTo Fehler
Set wbThis = ThisWorkbook
Set wksDiagramm = wbThis.Worksheets("Tabelle4")
'Diagrammblatt in neue Datei kopieren
wksDiagramm.Copy
Set wbDiag = ActiveWorkbook
'Ausgelagertes Diagrammblatt speichern
wbDiag.SaveAs Filename:=wbThis.Path & "\" _
& "Diagramm " & Format(Now, "YYYYMMDD hhmmss") & ".xls", _
FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False, AddToMRU:=True
'Link(s) zur Quelldatei entfernen (ersetzt Formeln durch Werte)
astrLinks = wbDiag.LinkSources(Type:=xlLinkTypeExcelLinks)
If IsArray(astrLinks) Then
For intI = LBound(astrLinks) To UBound(astrLinks)
wbDiag.BreakLink _
Name:=astrLinks(intI), _
Type:=xlLinkTypeExcelLinks
Next
Else
MsgBox "Es sind keine Excel-Links vorhanden oder sonstiges Problem"
End If
wbDiag.Save
wbDiag.Close
Fehler:
With Err
If .Number  0 Then
MsgBox "Fehler-Nr. " & .Number & vbLf & .Description & vbLf & vbLf _
& "Die Verknüpfung zur Quell-Datei wurde im Diagramm ggf. nicht entfernt."
Resume Next
End If
End With
End Sub


Anzeige
AW: Abspeichern Tabellenblatt über CommandButton
09.01.2009 10:15:30
Beverly
Hi,
um die Diagramme gemeinsam als Bild abzuspeichern, kannst du es mit diesem Code versuchen:

Sub Bild_exportieren()
Dim inShapes As Integer
Dim inZaehler As Integer
Dim arrShapes()
Dim shBild As Shape
Dim chDiagramm As ChartObject
Dim strName As String
Application.ScreenUpdating = False
For Each shBild In ActiveSheet.Shapes
inZaehler = inZaehler + 1
If shBild.Type = 3 Then
ReDim Preserve arrShapes(0 To inShapes)
arrShapes(inShapes) = shBild.Name
inShapes = inShapes + 1
End If
Next shBild
If UBound(arrShapes()) > 0 Then ActiveSheet.Shapes.Range(arrShapes).Select
Selection.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
ActiveSheet.Paste
Set shBild = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
shBild.CopyPicture Appearance:=xlScreen, Format:=xlPicture
Set chDiagramm = ActiveSheet.ChartObjects.Add(0, 0, shBild.Width, shBild.Height)
With chDiagramm.Chart
.Paste
.Export Filename:="C:\Test\Bild.png", FilterName:="PNG" ' andere Grafikformate sind mö _
glich
End With
chDiagramm.Delete
Set chDiagramm = Nothing
Set shBild = Nothing
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Delete
Application.ScreenUpdating = True
End Sub




Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige