'Prüfen ob ein File geöffnet ist
'Privat function TestOpen gehört dazu
Sub TestFileOpen()
Dim iOpen As Integer
Dim sFile As String
sFile = InputBox("Path and Filename:", , "c:\test\test.xls")
If sFile = "" Then Exit Sub
iOpen = TestOpen(sFile)
Select Case iOpen
Case 0: MsgBox "Datei " & sFile & " ist frei"
Case 1: MsgBox "Datei " & sFile & " ist geöffnet"
Case 2: MsgBox "Datei " & sFile & " wurde nicht gefunden"
End Select
End Sub
Private Function TestOpen(sPath As String) As Integer
If Dir(sPath) = "" Then
TestOpen = 2
Else
On Error GoTo errorhandler
Open sPath For Random Access Read Lock Read Write As #1
Close #1
End If
errorhandler:
If Err = 70 Then TestOpen = 1
End Function
Sub test()
On Error Resume Next
Application.Run ("mappe3.xls!Test")
Application.Run ("mappe.xls!Test")
Application.Run ("mappe4.xls!Test")
End Sub
Option Explicit
Public Sub Makro_ausfuehren()
Dim myWorkbook As Workbook
On Error Resume Next
For Each myWorkbook In Workbooks
If myWorkbook.Name <> ThisWorkbook.Name Then Application.Run myWorkbook.Name & "!Test"
Next
End Sub
Sub Workbook_Makro_ausfuehren_Check()
Dim myWorkbook As Workbook
For Each myWorkbook In Application.Workbooks
If Check_MakroList(myWorkbook.Name, "Sub Test") Then
MsgBox "Vorhanden"
'Application.Run myWorkbook.Name & "!Test"
End If
Next
End Sub
Function Check_MakroList(wb As String, chkCode As String) As Boolean
Dim vbc As Object, iRow As Integer, iCol As Integer, iCounter As Integer, sMacro As String
Check_MakroList = False
For Each vbc In Workbooks(wb).VBProject.VBComponents
With vbc.CodeModule
For iCounter = 1 To .CountOfLines
If .ProcOfLine(iCounter, 0) > "" Then
sMacro = .ProcOfLine(iCounter, 0)
If InStr(1, sMacro, chkCode) > 0 Then
Check_MakroList = True
Exit Function
End If
End If
Next iCounter
End With
Next vbc
End Function
Function IsOpen(fn) As Boolean
Dim dummy As String
On Error GoTo NichtOffen
dummy = Workbooks(fn).Name
'kein Fehler, dann offen:
IsOpen = True
Exit Function
NichtOffen:
IsOpen = False
End Function