Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen

Prüfen auf geöffneter Datei - advanced

Betrifft: Prüfen auf geöffneter Datei - advanced von: Schmitty
Geschrieben am: 02.10.2014 13:59:50

Hallo zusammen,

da bin ich schon wieder:

Nächstes "Spezial-Problem". Ich nutze folgenden Code, um per Knopfdruck zu prüfen, ob eine andere Excel-Datei geöffnet ist. Ist das der Fall, wird eine Zelle gelb gefärbt ansonsten blau:

' Prüfen ob die "Kunden-Datenbank" geöffnet ist
Function IsWorkbookOpen(strWB As String) As Boolean
   On Error Resume Next
   IsWorkbookOpen = Not Workbooks(strWB) Is Nothing
End Function
'Test
Sub test()
   If IsWorkbookOpen("Adressen.xlsm") Then
                Range("A1" & Y).Select
                With Selection.Interior
                .ColorIndex = 6
                .Pattern = xlSolid
End With
   Else
      Range("A1" & Y).Select
                With Selection.Interior
                .ColorIndex = 5
                .Pattern = xlSolid
                End With
   End If
End Sub
So, und jetzt zu dem geplanten kompliziertem Umbau:

Ich möchte, dass immer geprüft wird, ob die andere Excel-Datei vorhanden ist, also ich möchte den Button einsparen.
Und als Ergebniss möchte ich, dass nicht eine Zelle eingefärbt wird, sondern der Backgound eines CommandButtons (Name: "Sub Bearbeiten_Click()")

Gruß
Christian

  

Betrifft: AW: Prüfen auf geöffneter Datei - advanced von: Martin
Geschrieben am: 02.10.2014 14:29:33

Hallo Christian,

versuche es mal so:

'Dieser Code kommt in "DieseArbeitsmappe"

Private Sub Workbook_Activate()
    Call test
End Sub

Private Sub Workbook_Deactivate()
    Call test
End Sub

Deine alten Makros ersetzt du hiermit:
Function IsWorkbookOpen(strWB As String) As Boolean
   On Error Resume Next
   IsWorkbookOpen = Not Workbooks(strWB) Is Nothing
End Function
'Test
Sub test()
    With ThisWorkbook.Sheets("Tabelle1").CommandButton1 'Tabellennamen anpassen!
        If IsWorkbookOpen("Adressen.xlsm") Then
             .BackColor = RGB(255, 255, 0)
        Else
             .BackColor = RGB(0, 0, 255)
        End If
    End With
End Sub
Viele Grüße

Martin


  

Betrifft: AW: Prüfen auf geöffneter Datei - advanced von: Schmitty
Geschrieben am: 02.10.2014 15:06:54

Hallo Martin,

dein Code funktioniert fast!

Der Button ändert die Farbe, wenn die andere Excel-Datei geöffnet wird in gelb. Jedoch wird der Button nicht wieder blau, wenn die andere Excel-Datei geschlossen wurde... :-/

Gruß
Christian


  

Betrifft: AW: Prüfen auf geöffneter Datei - advanced von: Daniel
Geschrieben am: 02.10.2014 14:37:17

HI

im Modul "DieseArbeitsmappe":

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'--- Beim Schließen der Datei automatischen Aufruf stoppen
If NächsterCheck > Now Then _
    Application.OnTime NächsterCheck, "PrüfenObDateiGeöffnet", schedule:=False
End Sub


Private Sub Workbook_Open()
Call PrüfenObDateiGeöffnet
End Sub
in einem allgemeinen Modul:
Option Explicit
Public NächsterCheck As Date


Sub PrüfenObDateiGeöffnet()
On Error Resume Next
With Workbooks("Addressen.xlsm")
    If Err = 0 Then
        Tabelle1.CommandButton1.BackColor = vbGreen
    Else
        Tabelle1.CommandButton1.BackColor = vbRed
    End If
End With
On Error GoTo 0
NächsterCheck = Now + TimeSerial(0, 0, 1)
Application.OnTime NächsterCheck, "PrüfenObDateiGeöffnet"
End Sub
der Code prüft jede Sekunde, ob eine entsprechende Datei geöffnet ist.

Gruß Daniel


 

Beiträge aus den Excel-Beispielen zum Thema "Prüfen auf geöffneter Datei - advanced"