Hallo,
wenn du von der aufrufenden Mappe keinen Zugriff auf die andere Mappe benötigst, ändere das Makro so:
Public Sub Start()
Dim objExcel As Application
Set objExcel = CreateObject("Excel.Application")
Call objExcel.Workbooks.Open(Filename:="Z:\Intern\Montageleitung\Wocheneinteilung.xlsm")
Set objExcel = Nothing
End Sub
In der aufgerufenen Mappe:
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Private Sub Workbook_Open()
Call Application.OnTime(Now, "StartUserform")
End Sub
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Public Sub StartUserform()
UserForm1.Show
End Sub
' **********************************************************************
' Modul: UserForm1 Typ: Userform
' **********************************************************************
Option Explicit
Private Declare PtrSafe Function SetForegroundWindow Lib "user32.dll" ( _
ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function FindWindowA Lib "user32.dll" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetWindowLongA Lib "user32.dll" ( _
ByVal hwnd As LongPtr, _
ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function SetWindowLongA Lib "user32.dll" ( _
ByVal hwnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr) As LongPtr
Private Declare Function SetActiveWindow Lib "user32.dll" ( _
ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function FormatMessageA Lib "kernel32.dll" ( _
ByVal dwFlags As Long, _
ByRef lpSource As Any, _
ByVal dwMessageId As Long, _
ByVal dwLanguageId As Long, _
ByVal lpBuffer As String, _
ByVal nSize As Long, _
ByRef Arguments As LongPtr) As Long
Private Declare PtrSafe Function GetLastError Lib "kernel32.dll" () As Long
Private Const GWL_EXSTYLE As Long = -20&
Private Const WS_EX_APPWINDOW As LongPtr = &H40000
Private Const LANG_NEUTRAL As Long = &H0
Private Const ERROR_BUFFER As Long = &HC8
Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
Private Const GC_CLASSNAMEUSERFORM As String = "ThunderDFrame"
Private Sub CommandButton1_Click()
Call Unload(Me)
End Sub
Private Sub UserForm_Activate()
Dim lngptrFormHwnd As LongPtr, lngptrStyle As LongPtr
Dim lngptrReturn As LongPtr, lngptrThreadWindow As LongPtr
Dim lngptrForegroundWindow As LongPtr, lngptrThreadForeWindow As LongPtr
Dim strBuffer As String
With Application
.IgnoreRemoteRequests = True
.Visible = False
End With
lngptrFormHwnd = FindWindowA(GC_CLASSNAMEUSERFORM, Caption)
If lngptrFormHwnd = 0 Then Call Err.Raise(Number:=vbObjectError, _
Description:="Userformfenster nicht gefunden.")
lngptrStyle = GetWindowLongA(lngptrFormHwnd, GWL_EXSTYLE)
If lngptrStyle = 0 Then
strBuffer = Space$(ERROR_BUFFER)
Call FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, GetLastError, _
LANG_NEUTRAL, strBuffer, ERROR_BUFFER, ByVal CLngPtr(0))
Call Err.Raise(Number:=vbObjectError, Description:=strBuffer)
Else
lngptrStyle = lngptrStyle Or WS_EX_APPWINDOW
lngptrReturn = SetWindowLongA(lngptrFormHwnd, GWL_EXSTYLE, lngptrStyle)
If lngptrReturn = 0 Then
strBuffer = Space$(ERROR_BUFFER)
Call FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, GetLastError, _
LANG_NEUTRAL, strBuffer, ERROR_BUFFER, ByVal CLngPtr(0))
Call Err.Raise(Number:=vbObjectError, Description:=strBuffer)
Else
DoEvents
lngptrReturn = SetForegroundWindow(CLngPtr(Application.hwnd))
If lngptrReturn = 0 Then
strBuffer = Space$(ERROR_BUFFER)
Call FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, GetLastError, _
LANG_NEUTRAL, strBuffer, ERROR_BUFFER, ByVal CLngPtr(0))
Call Err.Raise(Number:=vbObjectError, Description:=strBuffer)
Else
DoEvents
lngptrReturn = SetForegroundWindow(lngptrFormHwnd)
If lngptrReturn = 0 Then
strBuffer = Space$(ERROR_BUFFER)
Call FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, GetLastError, _
LANG_NEUTRAL, strBuffer, ERROR_BUFFER, ByVal CLngPtr(0))
Call Err.Raise(Number:=vbObjectError, Description:=strBuffer)
End If
End If
End If
End If
Exit Sub
err_exit:
Call MsgBox("Fehler: " & CStr(Err.Number) & vbLf & vbLf & _
Err.Description, vbCritical, "Fehlermeldung")
End Sub
Private Sub UserForm_Terminate()
With Application
.IgnoreRemoteRequests = False
.Visible = True
.WindowState = xlMaximized
End With
End Sub
Das Userform kommt in den Vordergrund und bekommt einen Eintrag in der Taskleiste damit du es hinter einem anderen Fenster wieder hervorholen kannst.
Gruß
Nepumuk