VBA

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
  • VBA von Dirk vom 11.12.2003 14:21:43
    • AW: VBA - von Andi_H am 11.12.2003 15:37:56
Bild

Betrifft: VBA
von: Dirk
Geschrieben am: 11.12.2003 14:21:43

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

Bild


Betrifft: AW: VBA
von: Andi_H
Geschrieben am: 11.12.2003 15:37:56

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


Bild

Beiträge aus den Excel-Beispielen zum Thema " Sendmail Tabellenblatt"