VBA

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

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

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)

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread