Makro abbrechen, wenn ... NEU
WalterK
ich hatte mein Vorhaben eigentlich schon aufgegeben (hier mein 1. Versuch https://www.herber.de/forum/archiv/1216to1220/t1217358.htm), habe dann aber doch weiter gegoogelt und habe die Lösung schon fast erreicht.
Ich möchte erreichen, dass der Beispielcode "Sortieren" mit einer MSG-Box abgebrochen wird, wenn neben der aktuellen Arbeitsmappe noch andere Mappen oder Instanzen offen sind.
Inzwischen habe ich es geschafft, dass in einer MSG-Box die Instanzen und Mappen gezählt werden.
Folgende Änderungen/Ergänzungen sollte ich im Code noch haben:
1.) Bei der MSG-Box sollte im Bereich " & intCounter & " folgende Summierung erfolgen: " & Summe(ExcelInstanzen + intCounter - 1) & " d.h. zu der Zahl für intCounter soll die Zahl für ExcelInstanzen addiert und dann eine 1 subtrahiert werden.
2.) MSG-Box und Exit Sub soll nicht ausgeführt werden, wenn 1 Instanz und 1 Mappe offen ist.
Hier der Code:
Option Explicit
Sub Tabelleneusortieren()
Dim objWorkbook As Workbook, objWindow As Window
Dim intCounter As Integer
For Each objWorkbook In Application.Workbooks
For Each objWindow In objWorkbook.Windows
If objWindow.Visible Then
intCounter = intCounter + 1
Exit For
End If
Next
Next
MsgBox "Derzeit ist/sind " & ExcelInstanzen & " EXCEL - INSTANZ(EN) mit insgesamt " & _
intCounter & " Arbeitsmappe(n) geöffnet. Es darf nur 1 Excel-Instanz mit 1 Arbeitsmappe offen sein!"
Exit Sub
'***Hier beginnt der Beispiel-Code zum sortieren der Tabelle.
'***Der SortierCode soll nur ausgeführt werden, wenn nur noch 1 ExcelInstanz und 1 Arbeitsmappe _
offen ist.
Dim Lz As Long
Dim Ls As Long
Ls = Cells(2, Columns.Count).End(xlToLeft).Column
Lz = Range(Columns(1), Columns(Ls)).SpecialCells(xlCellTypeLastCell).Row
Range(Cells(3, 1), Cells(Lz, Ls)).Select
Application.Dialogs(xlDialogSort).Show , , , , , , , xlNo
End Sub
Function ExcelInstanzen() As Integer
Dim objWMI As Object
Set objWMI = GetObject("winmgmts:\\.\root\cimv2").ExecQuery("select * from win32_process where _
name='excel.exe' ")
ExcelInstanzen = objWMI.Count
End Function