AW: Variante mit Datei öffnen
15.03.2008 10:38:00
Tino
Hallo,
du könntest aber noch diese Version Testen, vielleicht ist diese ja doch etwas schneller
wie diese mit Formel.
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Pfad As String
Dim Datei As String
If Intersect(Target, Range("A2:A800")) Is Nothing Then Exit Sub
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error GoTo Fehler: 'Sichheit bei Fehler
Pfad = "I:\Vetropack\Womat\PAs - nach SAP-Nummer" & "\"
If Target > "" Then
Datei = Target & ".xls"
'Datei öffnen
Workbooks.Open _
(Filename:=Pfad & Datei, UpdateLinks:=0).RunAutoMacros xlAutoDeactivate
ActiveWindow.Visible = False
With Workbooks(Datei).Sheets(1) 'nur erste Tabelle ansprechen oder Name _
eintragen
'Daten übertragen
'Offset(0, 1) = von der Doppelklickzelle eine Zelle nach rechts
'Offset(0, 2) = von der Doppelklickzelle zwei Zelle nach rechts
Target.Offset(0, 1) = .Range("D11")
Target.Offset(0, 2) = .Range("D6")
'...eventuell weitere Zellen
'...eventuell weitere Zellen
'...eventuell weitere Zellen
'...usw.
End With
'Datei wieder schließen
Workbooks(Datei).Close
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Exit Sub
Fehler:
On Error Resume Next
Workbooks(Datei).Close
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
MsgBox "Es sind Fehler bei der verarbeitung aufgetreten", vbCritical, "schwerer Fehler!"
End Sub
Gruß
Tino