Datei durch Makro öffnen und durch ein anderes Makro schließen
Ich hoffe mir kann hier wieder einmal Geholfen werden.
Also ich habe zwei Makros geschrieben und als Add In (.dot) gespeichert.
Dann habe ich sie zwei Schaltflächen in der Menüleiste hinterlegt.
Der eine Button löst eine Art Suchfunktion aus in dem nach Stichworten gesucht werden die in einer Tabelle gespeichert sind,
die geöffnet wird bevor die Suche startet.
Was ich erreichen möchte ist das dieses Dokument mit der Tabelle automatisch nach der Suche geschloßen wird.
Irgendwie klappt das mit den normalen Schritten nicht.
Ich hab auch bereits versucht nachdem die Tabelle geöffnet wurde über die Aufzeichnungsfunktion auf das Dokument zuzugreifen.
Das hat aber nicht funktioniert. Keine Ahnung warum nicht.
Sub Suche_starten()
'
'
Dim AppWD As Object
Dim y As Integer
Set rDoc = ActiveDocument
Dim ADoc As Document
Set ADoc = Documents(1)
If Offen("D:\Begriff.docx") Then
' Hier soll Dokument "Begriff.docx" geschlossen werden
Set AppWD = CreateObject("Word.Application")
AppWD.Visible = True
Set rDoc = AppWD.Documents.Open("D:\Begriff.docx")
a = rDoc.Tables(1).Rows.Count
For i = 2 To a
b = Left(rDoc.Tables(1).Cell(i, 1).Range.Text, _
Len(rDoc.Tables(1).Cell(i, 1).Range.Text) - 2)
C = Left(rDoc.Tables(1).Cell(i, 2).Range.Text, _
Len(rDoc.Tables(1).Cell(i, 2).Range.Text) - 2)
ADoc.Activate
.
.
' Suchfunktion
.
.
Next
Else
Set AppWD = CreateObject("Word.Application")
AppWD.Visible = True
Set rDoc = AppWD.Documents.Open("D:\Begriff.docx")
a = rDoc.Tables(1).Rows.Count
For i = 2 To a
b = Left(rDoc.Tables(1).Cell(i, 1).Range.Text, _
Len(rDoc.Tables(1).Cell(i, 1).Range.Text) - 2)
C = Left(rDoc.Tables(1).Cell(i, 2).Range.Text, _
Len(rDoc.Tables(1).Cell(i, 2).Range.Text) - 2)
ADoc.Activate
.
.
' Suchfunktion
.
.
Next
' Hier soll Dokument "Begriff.docx" geschlossen werden
End If
End Sub
Function Offen(filename As String)
Dim filenum As Integer, errnum As Integer
On Error Resume Next
filenum = FreeFile()
Open filename For Input Lock Read As #filenum
Close filenum
errnum = Err
On Error GoTo 0
Select Case errnum
'Datei nicht geöffnet
Case 0
Offen = False
'Datei bereits geöffnet
Case 70
Offen = True
Case Else
Error errnum
End Select
End Function
Ich hoffe es hat jemand ein Idee!!
Danke und Gruß an alle!
Also ich habe zwei Makros geschrieben und als Add In (.dot) gespeichert.
Dann habe ich sie zwei Schaltflächen in der Menüleiste hinterlegt.
Der eine Button löst eine Art Suchfunktion aus in dem nach Stichworten gesucht werden die in einer Tabelle gespeichert sind,
die geöffnet wird bevor die Suche startet.
Was ich erreichen möchte ist das dieses Dokument mit der Tabelle automatisch nach der Suche geschloßen wird.
Irgendwie klappt das mit den normalen Schritten nicht.
Ich hab auch bereits versucht nachdem die Tabelle geöffnet wurde über die Aufzeichnungsfunktion auf das Dokument zuzugreifen.
Das hat aber nicht funktioniert. Keine Ahnung warum nicht.
Sub Suche_starten()
'
'
Dim AppWD As Object
Dim y As Integer
Set rDoc = ActiveDocument
Dim ADoc As Document
Set ADoc = Documents(1)
If Offen("D:\Begriff.docx") Then
' Hier soll Dokument "Begriff.docx" geschlossen werden
Set AppWD = CreateObject("Word.Application")
AppWD.Visible = True
Set rDoc = AppWD.Documents.Open("D:\Begriff.docx")
a = rDoc.Tables(1).Rows.Count
For i = 2 To a
b = Left(rDoc.Tables(1).Cell(i, 1).Range.Text, _
Len(rDoc.Tables(1).Cell(i, 1).Range.Text) - 2)
C = Left(rDoc.Tables(1).Cell(i, 2).Range.Text, _
Len(rDoc.Tables(1).Cell(i, 2).Range.Text) - 2)
ADoc.Activate
.
.
' Suchfunktion
.
.
Next
Else
Set AppWD = CreateObject("Word.Application")
AppWD.Visible = True
Set rDoc = AppWD.Documents.Open("D:\Begriff.docx")
a = rDoc.Tables(1).Rows.Count
For i = 2 To a
b = Left(rDoc.Tables(1).Cell(i, 1).Range.Text, _
Len(rDoc.Tables(1).Cell(i, 1).Range.Text) - 2)
C = Left(rDoc.Tables(1).Cell(i, 2).Range.Text, _
Len(rDoc.Tables(1).Cell(i, 2).Range.Text) - 2)
ADoc.Activate
.
.
' Suchfunktion
.
.
Next
' Hier soll Dokument "Begriff.docx" geschlossen werden
End If
End Sub
Function Offen(filename As String)
Dim filenum As Integer, errnum As Integer
On Error Resume Next
filenum = FreeFile()
Open filename For Input Lock Read As #filenum
Close filenum
errnum = Err
On Error GoTo 0
Select Case errnum
'Datei nicht geöffnet
Case 0
Offen = False
'Datei bereits geöffnet
Case 70
Offen = True
Case Else
Error errnum
End Select
End Function
Ich hoffe es hat jemand ein Idee!!
Danke und Gruß an alle!
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 142037
Url: https://administrator.de/contentid/142037
Ausgedruckt am: 26.11.2024 um 02:11 Uhr