Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
540to544
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
540to544
540to544
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Datenexport

Datenexport
30.12.2004 20:29:39
Helle
Hallo zusammen,
ich hab (mit Hilfe des Forums) folgendes Modul zum Export des aktiven Blattes einer Mappe in eine neue Excel Mappe gebastelt.

Sub Exportfunktion()
Application.ScreenUpdating = False
ActiveSheet.Copy
Application.SendKeys ActiveSheet.Name & "_" & Format(Date, "dd.mm.yyyy") & ".xls" & "+{HOME}"
Application.Dialogs(xlDialogSaveAs).Show
ActiveWorkbook.Close savechanges:=True
MsgBox "Die Daten wurden erfolgreich exportiert.", vbInformation + vbOKOnly, "Export erfolgreich"
Application.ScreenUpdating = True
End Sub

Hierzu habe ich zwei Fragen:
1. Das aktive Arbeitsblatt kann u.U. Verknüpfungen enthalten. Wo und wie kann ich einen Befehl á la "Paste Value" einbauen. Es soll also der Wert UND das Format übertragen werden.
2. Das aktive Blatt kann auch ein Chart sein. Gibts bei Diagrammen auch was ähnliches wie "nur Werte". Ich möchte die "lästige" Abfrage: Daten aktualisieren? beim öffnen der neu erzeugten Mappe unterbinden.
Bin für jeden Tipp dankbar!!!!
Viele Grüße
Tobias

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Hab noch was vergessen
30.12.2004 20:31:28
Helle
Außerdem würde ich noch gerne eine Speicherpfad vorschlagen.
Geht das?
Danke und Gruß
Tobias
AW: Datenexport
Ramses
Hallo
Darf ich dir mal eine kleine Verbesserung vorschlagen ?
Schmeiss das "SendKeys" raus :-)

Sub Exportfunktion()
Application.ScreenUpdating = False
ActiveSheet.Copy
Cells.Copy
Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
ActiveWorkbook.SaveAs ActiveSheet.Name & "_" & Format(Date, "dd.mm.yyyy") & ".xls"
ActiveWorkbook.Close savechanges:=True
MsgBox "Die Daten wurden erfolgreich exportiert.", vbInformation + vbOKOnly, "Export erfolgreich"
Application.ScreenUpdating = True
End Sub

Das Einfügen der Werte ist gleich eingebaut :-)
2. Ein Diagramm kann nicht exportiert werden ohne einen Link auf die Original-Daten
Gruss Rainer
Anzeige
AW: Datenexport
30.12.2004 20:54:10
Helle
Hallo Rainer,
klar darfs Du mir eine Verbesserungsvorschlag unterbreiten. Ich bin für jeden Tipp dankbar. Und für Tipps von einem Profi wie Dir schon dreimal!!!!
Ehrlich gesagt weiß ich nicht mal was SendKeys genau macht. Ich habs nur aus einem Vorschlag übernommen gehabt? Wo liegt das Problem dabei?
Dein Vorschlag fügt jetzt aber nur die Werte ein, ich bräucht aber noch die Formatierung, das wär wichtig!
Zu der Sache mit den Diagrammen: Wenn es dort eine solche Funktion (Paste Values) nicht gibt, gibt irgendeine Möglichkeit diese Abfrage "Wollen Sie Daten aktualisieren zu unterbinden (Linkupdate:=false o.ä.?)
Hättest Du vielleicht auch eine Idee zu meiner Frage mit dem Pfadvorschlag?
Vielen Dank und viele Grüße
Tobias
P.S. Im Übrigen möchte ich mich dem Lob von Frank, dass er im Forum geäußert gerne anschließen und Dir weiterhin einen guten Rutsch wünschen!!! ;-)
Anzeige
Auf ein Neues... :-)
Ramses
Hallo
Wenn du das Diagramm exportieren willst,... fällt mir nichts dazu ein, wie man die Abfrage beim öffnen unterdrücken kann. Unterdrücken ist möglich, wenn die Datei über VBA geöffnet wird. Aber sonst... ? Sorry. Fällt mir gerade nix zu ein.
Zu deinem sonstigen Problem, da ist etwas mehr Code notwendig.
Das gehört alles in ein Modul:
Option Explicit
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Declare

Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare 

Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Function GetDirectory(Msg) As String
Dim myInfo As BROWSEINFO
Dim mypath As String
Dim Root As Long, ID As Long, pos As Integer
With myInfo
.pidlRoot = 0&
.lpszTitle = Msg
.ulFlags = &H1
End With
ID = SHBrowseForFolder(myInfo)
mypath = Space$(512)
Root = SHGetPathFromIDList(ByVal ID, ByVal mypath)
If Root Then
pos = InStr(mypath, Chr$(0))
GetDirectory = Left(mypath, pos - 1)
Else
GetDirectory = ""
End If
End Function

'
'

Sub Exportfunktion()
Dim SavePath As String
Dim Qe As String, saveMsg As String
saveMsg = "Wählen Sie ein Verzeichnis aus," & Chr(13) & "in dem die Datei gespeichert werden soll:"
Restart:
SavePath = GetDirectory(saveMsg)
If SavePath = "" Then
MsgBox "Export abgebrochen weil kein Pfad definiert wurde", vbCritical + vbOKOnly, "Abbruch"
Exit Sub
End If
Qe = MsgBox("Soll die Datei im Pfad: " & SavePath & " gespeichert werden?", vbQuestion + vbYesNo, "Sicherung")
If Qe = vbNo Then
MsgBox "Export wurde abgebrochen"
Exit Sub
End If
Application.ScreenUpdating = False
ActiveSheet.Copy
Cells.Copy
Range("A1").PasteSpecial Paste:=xlPasteValues
Range("A1").PasteSpecial Paste:=xlPasteFormats
Range("A1").Select
Application.CutCopyMode = False
ActiveWorkbook.SaveAs SavePath & "\" & ActiveSheet.Name & "_" & Format(Date, "dd.mm.yyyy") & ".xls"
ActiveWorkbook.Close savechanges:=True
MsgBox "Die Daten wurden erfolgreich exportiert.", vbInformation + vbOKOnly, "Export erfolgreich"
Application.ScreenUpdating = True
End Sub

Gruss Rainer
Anzeige
AW: Auf ein Neues... :-) ja!!! ;-)
30.12.2004 21:21:55
Helle
Hi Rainer!
Vielen Dank ich werds morgen ausprobieren (brauch da erst mal ein bisschen Zeit um das zu veraduen und ansatzweise nachvollziehen zu können).
Bis dann!! Viele Grüße
Tobias
AW: Datenexport
30.12.2004 21:19:20
Matthias
Hallo Tobias,
der Vorschlag mit SendKeys war von mir, und ich gebe zu, es war nicht der beste ;-)
meine Alternative, inclusive vorgegebenen Speicherort:
Sub test()
Dim s
ActiveSheet.Copy
ChDrive ("D:\")
ChDir ("D:\Test")
s = Application.GetSaveAsFilename(InitialFileName:=ActiveSheet.Name & "_" & Format(Date, "dd.mm.yyyy") & ".xls", _
FileFilter:="Excel-Arbeitsmappe,*.xls")
On Error Resume Next
If s <> False Then
ActiveWorkbook.SaveAs Filename:=s
End If
If ActiveWorkbook.Saved = False Then
MsgBox "Fehler beim Speichern der Datei!"
Else
MsgBox "Die Daten wurden erfolgreich exportiert.", vbInformation + vbOKOnly, "Export erfolgreich"
End If
ActiveWorkbook.Close SaveChanges:=False
End Sub
Hier ist außerdem gewährleistet, dass die Meldung "erfolgreich" auch wirklich nur kommt, wenn das speichern auch erfolgreich war...
Grüße,
Matthias
Anzeige
AW: Datenexport
Ramses
Hallo
Dann wollen wir das "OnError Resume Next" aber ganz schnell wieder entfernen.
Sonst ist nachfolgend gar nichts mehr sicher gewährleistet :-)
Gruss Rainer
AW: Datenexport
30.12.2004 21:27:17
Matthias
Hallo Rainer,
noch so ein On Error-Vermeider... ;-)
was kann denn bis zum End Sub noch groß passieren?
Neugierig:
Matthias
AW: Datenexport
Ramses
Hallo Matthias
eigentlich nichts mehr :-)
Allerdings ist
If s False Then
ActiveWorkbook.SaveAs Filename:=s
End If
überflüssig.
Wenn er im Dialog
s = Application.GetSaveAsFilename(...
auf "OK" klickt, wird die Datei sowieso schon im definierten Pfad gespeichert.
Du speicherst dann einfach nochmals ;-)
Gruss Rainer
Anzeige
AW: Datenexport
30.12.2004 21:54:09
Matthias
Hallo Rainer,
aus der Excel-Hilfe:
GetSaveAsFilename-Methode
Zeigt das Standarddialogfeld Speichern unter an und bekommt einen Dateinamen vom Benutzer, ohne jedoch irgendwelche Dateien zu speichern.
Was sagst du dazu? (*triumphier*)
Gruß Matthias
Akzeptiert :-))
Ramses
Hallo Matthias
muss wohl doch öfter mal die Hilfe lesen :-))
Gruss Rainer

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige