HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Forumbeitrag
Excel-Version des Fragestellers:
365 Business
Erfahrungslevel des Fragestellers:
Excel gut - VBA bescheiden
Dieter
23.10.2025 15:35:46
AW: Du könntest dir auch...
Hi Case,

ich glaube ich check es nicht. Ich habe hier einen Beitrag "Thema: Prüfen, ob Arbeitsmappe geöffnet und wenn nein, öffnen" gefunden das mein Problem lösen könnte, aber so ganz kann ich es nicht umsetzen. Im Makro wird geprüft ob die Datei offen ist. Wenn die Datei nicht offen ist läuft das Makro durch. Wenn die Datei offen ist hängt es sich auf ohne Meldung.

Der unten abgebildete Code ist ohne den Kopiervorgang von Word in Excel, weil dieser glaube ich nicht mein Problem ist. Kann mir bitte wer sagen was ich falsch gemacht habe? Bestimmt einiges. Ich habe es nach besten wissen versucht :-/



Sub DatenKopieren()
Dim xlApp As Object 'Excel.Application
Dim xlMappe As Object 'Excel.Workbook
Dim xlBlatt As Object 'Excel.Worksheet
Dim wdDocument As Document
Dim rngTable As Range
Dim wbOpen, As String

wbOpen = "Arbeitsdokument.xlsm"

If WkbExists( "Arbeitsdokument.xlsm") = False Then
If Dir(Folder) = "" Then
MsgBox "Datei " & Folder & " wurde nicht gefunden!"
Else
Application.ScreenUpdating = False
'Set Document verwende ich um die Infos aus einer Word Tabelle in Excel zu schieben
Set wdDocument = ActiveDocument
Set rngTable = wdDocument.Tables(1).Cell(1, 2).Range

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
xlApp.ScreenUpdating = False
Set xlMappe = xlApp.Workbooks.Open(Folder)
Set xlBlatt = xlMappe.Sheets("Tabelle1")

With xlBlatt
'Informationen kopieren
End With

xlMappe.Close SaveChanges:=True
Set xlBlatt = Nothing
Set xlMappe = Nothing
xlApp.Application.Quit
Set xlApp = Nothing
Application.ScreenUpdating = True
End If
Else
Application.ScreenUpdating = False
Workbooks(Folder).Activate
Set wdDocument = ActiveDocument
Set rngTable = wdDocument.Tables(1).Cell(1, 2).Range

Set xlApp = CreateObject("Excel.Application")
xlApp.ScreenUpdating = False
Set xlMappe = Workbooks(Folder)
Set xlBlatt = xlMappe.Sheets("Tabelle1")

With xlBlatt
'Informationen kopieren
End With

xlMappe.Close SaveChanges:=True
Set xlBlatt = Nothing
Set xlMappe = Nothing
Set xlApp = Nothing
Application.ScreenUpdating = True
End If
End Sub

'Function aus dem Forum
Private Function WkbExists(sPath As String) As Boolean
Dim wkb As Object
On Error Resume Next
Set wkb = Workbooks(sPath)
If Not wkb Is Nothing Then
WkbExists = True
End If
On Error GoTo 0
End Function
Als Antwort auf diesen Beitrag
Case
23.10.2025 10:52:58
Du könntest dir auch...
Moin Dieter, :-)

... die "GetObject-Funktion" anschauen: ;-)
https://learn.microsoft.com/de-de/office/vba/language/reference/user-interface-help/getobject-function

Also so der Spur nach: ;-)

Dim xlApp As Object

Dim xlMappe As Object
Dim xlBlatt As Object
'Set xlApp = CreateObject("Excel.Application")
Set xlMappe = GetObject("C:\Temp\975v.xlsx")
Set xlBlatt = xlMappe.Sheets("Tabelle1")
With xlBlatt
.Range("A2").Value = "NurEinTest"
'Daten die in die Excel geschrieben werden sollen
End With
xlMappe.Windows(1).Visible = True
xlMappe.Close SaveChanges:=True
Set xlBlatt = Nothing
Set xlMappe = Nothing
'Set xlApp = Nothing

"GetObject" öffnet die Datei, oder nimmt die schon geöffnete. ;-)

Das kann man noch mit diversen Fehlerbehandlungen ausbauen - wenn man will. ;-)

"With xlMappe.Sheets("Tabelle1")" ist doppelt gemoppelt. Da reicht "With xlBlatt". ;-)

Da "GetObject" ausgeblendet öffnet und du speicherst, musst du vorher wieder einblenden, sonst ist die Datei beim nächsten öffnen nicht sichtbar. ;-)

Ahh - und da wir gerade dabei sind - "Ich mag keine Rote Beete!". ;-)

Servus
Case
Folgenachrichten
Antwort auf Beitrag erstellen

Beispieldatei hochladen