VBA

Forumthread: VBA

VBA

11.12.2003 14:21:43

Dirk

Kann mir vielleicht jemand diese Zeilen erklären???

Vielen Dank im Vorraus!

Dirk


Private Sub Workbook_BeforePrint(Cancel As Boolean)
If Worksheets("Daten").Cells(1000, 1) = 0 Then
MsgBox "                       CT " _
+ Chr(10) + Chr(13) + "Drucken markieren nur nur mit Registrierung möglich!" _
+ Chr(10) + Chr(13) + "                   Siehe Registrierung"
For Each wk In Worksheets
wk.PageSetup.PrintArea = "$AZ$1:$BA$1"
wk.DisplayPageBreaks = False
Next
End If
End Sub


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Dim x, y As Long
Dim P As String
P = Worksheets("Daten").Cells(1000, 2) + "CT2003.exe"
If FileExist(P) Then
'MsgBox "OK"
Else
MsgBox "Unberechtigter Aufruf !"
Workbooks(ActiveWorkbook.Name).Close SaveChanges:=False
Workbooks.Close
End If
If Worksheets("Daten").Cells(1000, 1) = 0 Then
x = Target.Row
y = Target.Column
Worksheets(Sh.Name).Cells(x, y).Select
End If
End Sub

Public Function FileExist(Dateiname$) As Boolean
On Error GoTo fehler:
FileExist = Dir$(Dateiname) <> ""
Exit Function
fehler:
FileExist = False
Resume Next
End Function

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: VBA

11.12.2003 15:37:56

Andi_H

AW: VBA

11.12.2003 15:37:56

Andi_H

Hi Dirk,

bei dem ersten Code handelt es sich um ein Ereignis welches vor dem Drucken ausgelöst wird


Private Sub Workbook_BeforePrint(Cancel As Boolean)
If Worksheets("Daten").Cells(1000, 1) = 0 Then ' wenn im Tabellenblatt daten die Zelle A1000 leer ist dann
MsgBox "                       CT " _    ' dann erscheint diese Meldung
+ Chr(10) + Chr(13) + "Drucken markieren nur nur mit Registrierung möglich!" _
+ Chr(10) + Chr(13) + "                   Siehe Registrierung"
' ende der Meldung
For Each wk In Worksheets ' hier wird jedes Tabellenblatt deiner Mappe angesprochen
wk.PageSetup.PrintArea = "$AZ$1:$BA$1" ' und ein druckbereich gesetzt AZ1:BA1
wk.DisplayPageBreaks = False
Next
End If
End Sub

Teil 2 wird durch zellmarkierung (z.B. wechsel von A1 nach zelle A2) ausgelöst


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Dim x, y As Long ' deklaration der variablen
Dim P As String
P = Worksheets("Daten").Cells(1000, 2) + "CT2003.exe" 'TExtvariable P enthält wert aus Daten!B1000 und die endung CT2003.exe
If FileExist(P) Then ' hier wird geprüft ob diese Datei existiert
'MsgBox "OK" ' wenn ja meldung ja
Else
MsgBox "Unberechtigter Aufruf !" ' ansonsten diese Meldung
Workbooks(ActiveWorkbook.Name).Close SaveChanges:=False ' arbeitsmappe schließen ohne speichern
Workbooks.Close ' alle Mappen schließen
End If
If Worksheets("Daten").Cells(1000, 1) = 0 Then ' wenn Daten!A1000 leer ist
x = Target.Row 'x nimmt den Zeilenindex der gewählten zelle an
y = Target.Column ' y die spalte
Worksheets(Sh.Name).Cells(x, y).Select ' und diese Zelle markiert
End If
End Sub

letzter Teil ist eine Funktion welche prüft ob eine bestimmte datei existier, der Dateiname wird aus dem Selection_Change - Code übernommen und auch in diesen Code zurückgegeben aufruf erfolgt bei 2. If FileExist(P) Then

Public Function FileExist(Dateiname$) As Boolean
On Error GoTo fehler:
FileExist = Dir$(Dateiname) <> ""
Exit Function
fehler:
FileExist = False
Resume Next
End Function

Hoffe das hilft dir.

Gruß
Andi

Beliebteste Forumthreads (12 Monate)

Forumthread: VBA

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread