Hallihallo
Ich habe folgendes Problem:
Mein Skript soll beim Doppelclick auf ein Feld in der ersten Spalte den Wert des Feldes aufnehmen (keyword), dann eine zweite Datei öffnen und darin nach dem "keyword" suchen und die entsprechende Zelle auswählen. Das ganze drumherum dient dazu zu überprüfen, ob die Datei2 bereits geöffnet ist oder noch geöffnet werden muss.
Die Suchfunktion funktioniert einwandfrei, und ich kann auch die Zelle in Datei auswählen. Nur führen alle nachfolgenden Select Befehle (wenn ich zum Beispiel nach dem Suchen die ganze Zeile auswählen will) zu einem Fehler.
Muss eventuell die andere Datei noch in irgend einer weiße aktiviert werden? Mir ist nach langem rumprobieren das ganze etwas schleierhaft.
Hier das Skript:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)
Dim abbruch As Boolean
If ActiveCell.Column <> "1" Then 'Makro wird nur in erster Spalte angewendet
Exit Sub
End If
' Name der Verknüpften Datei
Dim Myworkbook As String
Myworkbook = "Datei 2.xls" 'hier den Dateinamen einsetzen, (zB: "Tabelle.xls")
' Pfad zur Datei
Dim Pfad As String
Pfad = "Pfad zu Datei \Datei2.xls" 'hier den Pfad der Datei angeben, (zB: "C:\Dokumente\Tabelle.xls")
Dim keyword As String 'Wert der Zele wird ausgelesen
keyword = Selection.Value
' Überprüfen ob Datei existiert, öffnet diese
Call Open_File_after_IsOpen_or_Not(Myworkbook, Pfad, abbruch)
If abbruch = True Then
Exit Sub
Else
End If
Sheets("Tabelle1").Select
ActiveSheet.Range("A1").Select
On Error GoTo fehler
' Suche nach keyword
ActiveSheet.Cells.Find(What:=keyword, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select
Exit Sub
fehler:
MsgBox "nicht in dieser Datei enthalten", Title:="fehlerhafter Eintrag"
End Sub
---------------------------------------------------
Sub Open_File_after_IsOpen_or_Not(Myworkbook As String, Pfad As String, abbruch As Boolean)
If Isopen(Myworkbook) = "Not Open" Then 'Datei ist noch nicht geöffnet
On Error GoTo Open_new
Workbooks.Open (Pfad)
Exit Sub
Else
Application.Workbooks(Myworkbook).Activate
End If
Exit Sub
Open_new:
Call Open_new_file(abbruch)
End Sub
-----------------------------------------------------
Sub Open_new_file(abbruch As Boolean)
On Error GoTo Ende
Workbooks.Open Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Please select a file")
Ende:
abbruch = True
End Sub
------------------------------------------------------------------------
Public Function Isopen(Myworkbook As String)
On Error Resume Next
Dim wBook As Workbook
Set wBook = Workbooks(Myworkbook)
If wBook Is Nothing Then
Isopen = "Not Open"
Exit Function
End If
End Function
Sorry... die Code-Funktion wollte bei mir auf Arbeit nicht so wirklich...
Vielen Dank schon mal für Antworten
|