Klassenmodule workbook open - close - save
09.10.2007 09:02:20
chris
ich arbeite wieder einmal mit klassen.
Versuche die ganze Zeit zu erreichen wenn ich über ein Makro "unten" eine Datei öffne diese nicht geschlossen und verlASSEN werden darf ohne das sie gespeichert wurde.
Wie bekomme ich es hin das die neu geöffnete datei über Workbooks.Open fileToOpen
nicht deaktiviert werden darf also das workbook und auch nicht geschlossen werden darf ohne das es gespeichert wurde.
Danke vielmals !
---------- MODUL1
Sub datei_bearbeiten()
Dim fileToOpen As String
Dim scount As Integer
Dim altname As String
Dim test As Workbook
Dim Wb() As New cls_changebook
Dim thiswb As Workbook
Dim ab As New cls_addbook
Dim altbook As New cls_addbook
Dim intcounter As Integer
'Starten um mitzubekommen ob wann datei geöffnet geschlossen gewechselt wird
intcounter = 0
For Each test In Application.Workbooks
ReDim Preserve Wb(intcounter)
Set Wb(intcounter).wechsel = test
intcounter = intcounter + 1
Next
Set ab.neu = Application
'-------- Ende bis hier -------
ChDrive "O:\"
ChDir "O:\test\"
fileToOpen = Application.GetOpenFilename("Text Files (*.xls), *.xls", , "Datei auswählen")
If fileToOpen "Falsch" Then
Workbooks.Open fileToOpen
Set thiswb = ActiveWorkbook
Else
MsgBox "keine Datei gewählt", vbCritical, "abbruch"
Exit Sub
End If
End Sub
---------- KLASSEN MODUL 1
Public WithEvents wechsel As Workbook
Sub wechsel_activate()
'MsgBox ("OK wechsel")
End Sub
Private Sub wechsel_BeforeClose(cancel As Boolean)
If MsgBox("Datei muss gespeichert werden" & Chr(10) & "Wollen Sie die Datei jetzt speichern ?", _
vbYesNo, "speicherm") = vbYes Then
Application.EnableEvents = False
ActiveWorkbook.Save
Application.EnableEvents = True
Else
MsgBox ("Schliesen der Datei ohne speichern nicht möglich !"), vbInformation, "Warnung"
cancel = True
End If
End Sub
Private Sub wechsel_Deactivate()
'MsgBox ("deaktivieren")
' Set thiswb = ActiveWorkbook
' Workbooks(thiswb.Name).Activate
End Sub
Private Sub wechsel_SheetDeactivate(ByVal Sh As Object)
MsgBox ("Sheet deaktivieren")
End Sub
Private Sub wechsel_WindowActivate(ByVal Wn As Window)
MsgBox ("OK")
End Sub
Private Sub wechsel_WindowDeactivate(ByVal Wn As Window)
MsgBox ("OK")
End Sub
---------- KLASSEN MODUL 2
Public WithEvents neu As Application
Private Sub neu_SheetChange(ByVal Sh As Object, ByVal Target As Range)
MsgBox ("OK")
End Sub
Private Sub neu_WorkbookOpen(ByVal Wb As Excel.Workbook)
' MsgBox "neue datei geöffnet"
Call zuf
End Sub
Private Sub neu_NewWorkbook(ByVal Wb As Excel.Workbook)
MsgBox "Bitte erst aktuelle Datei bearbeiten - speichern - schliesen"
Call zuf
End Sub