AW: Weitere Excel-Instanz mit VBA ohne Code-Blockierun
15.07.2008 16:34:46
Michael
Hallo Tino!
Es klappt wunderbar inzwischen. Ich habe das Script von Dir überarbeitet, wegen der Schreibschutznachfragen und einen Zeitcounter eingefügt. Um die Kollegen nicht zu verunsichern, was für eine Script-Datei da plötzlich ist, lasse ich sie per Code erzeugen und am Schluß wieder löschen.
Als erstes lese ich die Anzahl der Prozessorkerne aus:
' Benötigte API-Deklarationen, um Prozessorkerne auszulesen
Private Declare Sub GetSystemInfo Lib "kernel32" ( _
lpSystemInfo As SYSTEM_INFO)
Private Type SYSTEM_INFO
dwOemID As Long
dwPageSize As Long
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOrfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
dwReserved As Long
End Type
Private Sub UserForm_Activate()
Dim strAbfrageLEFT, strAbfrageTOP
Dim AnzahlCPU As Integer
'* Anzahl der Prozessoren ermitteln *
AnzahlCPU = NumProcessors()
'MsgBox CStr(nProcessorCount) & " Prozessor(en) installiert."
Firmendaten.AnzahlCPUs = AnzahlCPU
End Sub
Anhand dieser Zahl starte ich variabel die Anzahl der weiteren Excel-Anwendungen. Eine Checkbox bei der Anzeige der CPUs gibt mir die Möglichkeit, ohne Aufruf der Anwendungen bei kleinen Dateimengen zu arbeiten. Die nachfolgende Abfrage lasse ich dann beim Close der Userform ablaufen, um die VBS-Datei zu erzeugen:
'VBSCRIPT ERZEUGEN FÜR MULTITHREADING
If Firmendaten.CheckCPUNutzen = True And Sheets("Firmendaten").Range("S15") > 1 Then
file = ThisWorkbook.Path & "\Multithreading.vbs"
Sheets("Firmendaten").Range("C26") = file
fileXL = ThisWorkbook.Path & "\" & ThisWorkbook.Name '"\Multithreading.vbs"
filechannel = FreeFile()
Open file For Output As #filechannel
' Initialisierung
InfoText.InfoText_Text.Caption = "Erstelle Multithreading-Startprogramm..."
InfoText.InfoText_Time = Time - Sheets("Firmendaten").Range("B23")
'InfoText.Fortschrittsbalken.Width = 200 + (10 / Sheets("Firmendaten").Range("B1") * rw - 1)
DoEvents
'ANZAHL ZU STARTENDER CLIENTS
For i = 1 To Sheets("Firmendaten").Range("S15") - 1
Print #filechannel, "Set excel = WScript.CreateObject (""Excel.Application"")"
'Print #filechannel, ""
Print #filechannel, "excel.Workbooks.Open """ & fileXL & """"
If i
Next i
Print #filechannel, ""
Close #filechannel
End If
Schließlich und endich kommt der Shell-Aufruf, den ich in meinem Code für Datenanalyse direkt nach dem Öffnen der Fremd-Datei untergebracht habe.
'ZUM STARTEN DER WINDOWS-SCRIPTING-DATEI
Public Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hWnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nshowcmd As Long) As Long
'AUFRUF DER MULTITHREAFDING-DATEI
sub soundso
Dim Pfad As String
Pfad = FD.Range("C26")
If Firmendaten.CheckCPUNutzen = True Then Call ShellExecute(0, "open", Pfad, "", "", 6)
End Sub
Eingebettet habe ich das Ganze in eine Client-Verwaltung über die Registry. Beim Start der Mappe wird im Key MT nachgesehen, ob die mappe Client 1 oder höher wird.
Private Sub Workbook_Open()
'* ClientNr für Multithreading abfragen *
Dim strAbfrage As String
strAbfrage = GetSetting( _
appname:="MT-Proggi", _
section:="Client", _
Key:="ClientNr")
If strAbfrage = "" Then
ClientNr = 1
Else: ClientNr = CLng(strAbfrage) + 1
End If
Application.Caption = "MT-Proggi - Client " & ClientNr
Sheets("Firmendaten").Range("B26") = ClientNr
SaveSetting _
appname:="MT-Proggi", _
section:="Client", _
Key:="ClientNr", _
setting:=ClientNr
Application.Visible = False
If ClientNr = 1 Then Disclaimer.Show
Application.Visible = True
End Sub
Damit weist sich jeder Client mit einer eigenen Nummer aus. Beim Workbook_Close dann diese Eintragungen löschen und Excel und die Mappe ohne Nachfrage Ihrerseits schließen:
Sub Workbook_BeforeClose(Cancel As Boolean)
DeleteSetting _
appname:="MT-Proggi", _
section:="Client", _
Key:="ClientNr"
ActiveWorkbook.Saved = True
If ClientNr > 1 Then Application.Quit
End Sub
Vom Prinzip her öffne ich also meine Mappe X-mal. Vor dem Start der VBS, speicher ich meine Mappe, damit die Clients die aktuellen Einstellungen haben. Ich muss beim Aufruf der Clients also nur die Popups deaktivieren, weil ich die Einstellungen vom ersten Aufruf her kenne und lasse alles automatisch durchlaufen. Dazu rufe ich die Datei, die Bearbeitet werden soll, einmal auf und zähle durch von wo bis wo welcher Client zuständig ist.
ich hoffe, dass es den ein oder anderen helfen kann.
Gruß
Michael Heering