Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Daten aus geschlossener Excel Datei holen

510 views
Skip to first unread message

Franz Dietmeier

unread,
Jan 21, 2010, 11:54:26 AM1/21/10
to
Hallo,
habe folgendes Problem.
Möchte aus einer Excel-Datei heraus, von einer anderen Datei, die ich
mit:

Application.GetOpenFilename(("Micrsoft Excel-Dateien
(*.xls),*.xls"), , "ABR-Tag auswählen")

auswähle, aus einem bestimmten Sheet Daten kopieren.
Da ich leider das Sheet nicht kenne, frage ich, wie man auch das Sheet
in dieser o.a. Datei auswählen kann, aus dem ich dann die Daten
kopiere.
Vielleicht hat jemand eine Lösung.
Vielen Dank im vorraus

Andreas Killer

unread,
Jan 21, 2010, 12:26:31 PM1/21/10
to
Franz Dietmeier schrieb:

> M�chte aus einer Excel-Datei heraus, von einer anderen Datei, die ich
> mit:
> Application.GetOpenFilename(("Micrsoft Excel-Dateien
> (*.xls),*.xls"), , "ABR-Tag ausw�hlen")
>
> ausw�hle, aus einem bestimmten Sheet Daten kopieren.
Nun ja, ich gehe mal davon aus das Du die Datei dann mit
Set WB = Workbooks.Open(Dateiname)
�ffnest?

> Da ich leider das Sheet nicht kenne, frage ich, wie man auch das Sheet

> in dieser o.a. Datei ausw�hlen kann, aus dem ich dann die Daten
> kopiere.
Und aus welchem "bestimmten" Sheets das Du nicht kennst m�chtest Du
kopieren?

Du kannst Sheets via
WB.Sheets(Name)
oder
WB.Sheets(Nummer)
ansprechen.

Andreas.

Franz Dietmeier

unread,
Jan 21, 2010, 4:46:25 PM1/21/10
to

Hallo Andreas,

Die Situation ist folgende:

Ich habe eine Datei mit 7- 12 Sheets (je nach Anforderung) die
laufende Abrechnungstage beinhalten.
Diese Sheets sind folgendermassen benannt: MO 12-01, DI 13-01, MI
14-01, etc.
Da jeddoch nicht immer alle Sheets verwendet werden, ist es notwendig
das Sheet welches man braucht
auszuwählen, damit es in die laufende Monatsdatei kopiert wird.
Das ganze habe ich mit folgendem Code versucht:

Public Sub HoleDaten3()
Dim Pfad As String, Dateiname As String, Blatt As String, PfadIntern
As String
Dim tmpStr01 As String, tmpStr02 As String, tmpZeichen As Long,
tmpAnzahl As Long

PfadIntern = Application.GetOpenFilename(("Micrsoft Excel-Dateien
(*.xls),*.xls"), , "ABR-Tag auswählen")
tmpZeichen = InStrRev(PfadIntern, "\")
tmpAnzahl = Len(PfadIntern) - tmpZeichen
Pfad = Left(PfadIntern, tmpZeichen)
Dateiname = Right(PfadIntern, tmpAnzahl)
Blatt = "Mi 20-01"

If GetDataClosedWB(Pfad, _
Dateiname, _
Blatt, _
"A1:J192", _
Worksheets("Tabelle2").Range("A1")) Then
MsgBox "Daten importiert"
End If
End Sub

Public Function GetDataClosedWB(SourcePath As String, _
SourceFile As String, _
sourceSheet As String, _
SourceRange As String, _
TargetRange As Range) As Boolean


'Holt einen Bereich aus einer _geschlossenen_ Arbeitsmappe
'Nur in VBA zu verwenden; nicht aus einer Tabellenzelle heraus
t.ra...@mvps.org


Dim strQuelle As String
Dim Zeilen As Long
Dim Spalten As Byte


On Error GoTo InvalidInput


strQuelle = "'" & SourcePath & "[" & SourceFile & "]" & _
sourceSheet & "'!" & _
Range(SourceRange).Cells(1, 1).Address(0, 0)


Zeilen = Range(SourceRange).Rows.Count
Spalten = Range(SourceRange).Columns.Count


With TargetRange.Cells(1, 1).Resize(Zeilen, Spalten)
.Formula = "=IF(" & strQuelle & "="""",""""," & strQuelle & ")"
.Value = .Value
End With


GetDataClosedWB = True
Exit Function


InvalidInput:
MsgBox "Die Quelldatei oder der Quellbereich ist ungültig!", _
vbExclamation, "Get data from closed Workbook"
GetDataClosedWB = False
End Function

Wie gesagt kann ich aber nicht das Sheet "auswählen" bei dieser
Funktion.
Wie kann ich das lösen damit ich festlegen kann welches Sheet
ausgewählt werden soll.
Der Berreich bleibt immer gleich - ist vorgegeben.

Danke für jede Info.

Andreas Killer

unread,
Jan 22, 2010, 3:11:23 AM1/22/10
to
On 21 Jan., 22:46, Franz Dietmeier <pri...@fradie.at> wrote:

> Da jeddoch nicht immer alle Sheets verwendet werden, ist es notwendig
> das Sheet welches man braucht
> auszuwählen, damit es in die laufende Monatsdatei kopiert wird.

Und dazu musst Du die Datei öffnen, denn sonst kommst Du nicht an die
Sheets-Auflistung.

Wenn Du nun ein Sheet interaktiv auswählen möchtest würde ich die
Namen aller Sheets in eine Userform mit einer ListBox einlesen.

Andreas.

Franz Dietmeier

unread,
Jan 22, 2010, 3:42:36 AM1/22/10
to

Vielen Dank für die Hilfe - wollte ursprünglich die Datei nicht direkt
öffnen,
wird mir aber nun nichts anderes überbleiben.
Dachte es gibt vielleicht eine Möglichkeit die Sheet-Namen auszulesen.

Danke nochmals und falls wer anderer eine Lösung weis - bitte posten.

Franz

Andreas Killer

unread,
Jan 22, 2010, 6:16:06 AM1/22/10
to
On 22 Jan., 09:42, Franz Dietmeier <pri...@fradie.at> wrote:

> > Wenn Du nun ein Sheet interaktiv auswählen möchtest würde ich die
> > Namen aller Sheets in eine Userform mit einer ListBox einlesen.

> Vielen Dank für die Hilfe - wollte ursprünglich die Datei nicht direkt
> öffnen, wird mir aber nun nichts anderes überbleiben.

Dann ist das folgende vielleicht hilfreich.

Andreas.

Option Explicit

'Version 1.0
'Andreas Killer
'22.01.2010
'Eine Userform zum interaktiven Laden von Daten aus anderen _
Mappen

'Dieser Code gehört in eine Userform die eine ListBox _
(ListBox1) und zwei Commandbutton (Commandbutton1, _
Commandbutton2) hat.

'Code-Ablauf:
'Die Userform zeigt den GetOpenFileName-Dialog an und man kann _
eine Excel-Datei auswählen.
'Wurde eine Datei gewählt, dann werden in der ListBox die _
sichtbaren Tabellennamen angezeigt.
'Beim Klick auf einen Namen in der ListBox wird die Tabelle _
angezeigt.
'Beim Klick auf den OK-Button (Commandbutton1) werden die _
Daten aus der Tabelle in die vor dem Aufruf aktive Tabelle _
kopiert.

'In diese Tabelle zur Aufrufzeit werden die Daten kopiert
Private OurSheet As Worksheet
'Die Mappe aus der kopiert wird
Private SourceBook As Workbook
'Trick17 um im Initialize-Ereignis "Unload Me" sagen zu können
Private UnloadMe As Boolean

Private Sub CommandButton1_Click()
'Ok geklickt
Dim I As Long, J As Long
With ListBox1
'Wurde mind. ein Eintrag ausgewählt?
If .ListIndex < 0 Then Exit Sub
'Ja, Zellen in unsere Tabelle kopieren
SourceBook.Sheets(.List(.ListIndex)).Cells.Copy OurSheet _
.Cells(1, 1)
End With
Unload Me
End Sub

Private Sub CommandButton2_Click()
'Abbruch geklickt
Unload Me
End Sub

Private Sub ListBox1_Click()
With ListBox1
'Die angeklickte Tabelle anzeigen
SourceBook.Sheets(.List(.ListIndex)).Select
End With
End Sub

Private Sub UserForm_Activate()
'Schließt uns ggf. falls der User in UserForm_Initialize _
abbricht
If UnloadMe Then Unload Me
End Sub

Private Sub UserForm_Initialize()
Dim FName As Variant, WB As Workbook, WS As Worksheet, I As _
Long, fs As Object

'Fehlerbehandlung etablieren
On Error GoTo ErrorHandler

'Datei auswählen
FName = Application.GetOpenFileName("Microsoft Excel-Dateien " & _
"(*.xls),*.xls", , "Datei auswählen:")

'Abbruch?
If VarType(FName) = vbBoolean Then _
Err.Raise vbObjectError

'Wurde eine bereits geöffnetete Datei ausgewählt?
Set fs = CreateObject("Scripting.FileSystemObject")
For Each WB In Workbooks
If fs.GetFilename(FName) = WB.Name Then _
Err.Raise 55, , "Es ist nicht möglich eine Datei zu " & _
"öffnen die den gleichen Dateinamen wie eine bereits" & _
" geöffnete Mappe hat!"
Next

'Unsere Tabelle merken
Set OurSheet = ActiveSheet
'Mappe schreibgeschützt öffnen
Set SourceBook = Workbooks.Open(FName, False, True)

With Me
'Der Einfachheit halber:
.Caption = "Tabelle auswählen:"
With .CommandButton1
.Default = True
.Caption = "Laden"
End With
With .CommandButton2
.Cancel = True
.Caption = "Abbruch"
End With

'Alle sichtbaren Tabellen hinzufügen
For Each WS In SourceBook.Sheets
If WS.Visible Then
.ListBox1.AddItem WS.Name
'Den Namen des aktuellen Sheets in unserer Liste _
auswählen
If WS.Name = ActiveSheet.Name Then .ListBox1.ListIndex _
= I
I = I + 1
End If
Next
End With
Exit Sub

ErrorHandler:
'Fehler anzeigen
If Err.Number <> vbObjectError Then _
MsgBox "Fehler " & Err.Number & ": " & Err.Description
'Ein Unload Me in dieser Sub würde einen Fehler erzeugen!
UnloadMe = True
End Sub

Private Sub UserForm_Terminate()
'Mappe wieder zu falls geöffnet
If Not SourceBook Is Nothing Then SourceBook.Close
End Sub

Franz Dietmeier

unread,
Jan 22, 2010, 7:00:20 AM1/22/10
to

Hallo Andreas,
vielen Dank für den Code, werde mir das mal am Wochenende genauer
anschauen. Da hab ich mehr Zeit dazu.

Franz

0 new messages