Tabellen per Mail versenden
23.05.2006 14:45:12
Torge
wer kann helfen?
Folgendes:
Blende über Passwort A,B oder C verschiedene Blätter ein. Auf einem Blatt befindet sich ein Button, der das Blatt in dem das Passwort eingegeben wird und die ausgeblendeten Tabellen versenden soll. So weit ganz gut. Da der Code in Tabelle 1 ist besteht nun das Problem, dass nach dem Versand einige Seiten fehlen und damit eine Fehlermeldung beim Einblenden der Tabellen kommt. Kann man dies verhindern oder ausschließen?
Code in Tabelle1:
'Einblenden von Button in Abhängikeit der PW-Eingabe
Private Sub Worksheet_Change(ByVal Target As Range)
'Ausblenden der Tabellenblätter Einblenden über Eingabe Zahl Feld D4
'nur ausführen, wenn D4 geändert wurde:
If Intersect(Target, Range("D4")) Is Nothing Then Exit Sub
'Ergebnis durch Eingabe in Zelle
Select Case Range("D4").Value
Case 0 'alle Ausgeblendet
Sheets("Messe-Eingabe").Visible = False
Sheets("Messe-Berechnung").Visible = False
Sheets("Kurz-Eingabe").Visible = False
Sheets("Fin.-Anfrage").Visible = False
Sheets("Dateneingabe").Visible = False
Sheets("benötigte Unterlagen").Visible = False
Case "A" 'Anzeigen
Sheets("Messe-Eingabe").Visible = True
Sheets("Messe-Berechnung").Visible = True
Sheets("Kurz-Eingabe").Visible = True
Sheets("Fin.-Anfrage").Visible = True
Sheets("Dateneingabe").Visible = False
Sheets("benötigte Unterlagen").Visible = False
Case "B" 'Anzeigen
Sheets("Messe-Eingabe").Visible = True
Sheets("Messe-Berechnung").Visible = True
Sheets("Kurz-Eingabe").Visible = True
Sheets("Fin.-Anfrage").Visible = True
Sheets("Dateneingabe").Visible = True
Sheets("benötigte Unterlagen").Visible = True
End Select
End Sub
Code bei Mail versand:
'Tabelle per E-mail senden
Private Sub Worksheet_Change(ByVal Target As Range)
hide Target
End Sub
Sub hide(c As Range)
Application.ScreenUpdating = False
If Not ActiveSheet.Name = "Fin.-Anfrage" Then Exit Sub
If Intersect(c, Range("D12")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Select Case Range("D12")
Case 0
Sheets("Messe-Eingabe").Visible = False
Sheets("Messe-Berechnung").Visible = False
Sheets("Kurz-Eingabe").Visible = False
Sheets("Fin.-Anfrage").Visible = False
Sheets("Dateneingabe").Visible = False
Sheets("benötigte Unterlagen").Visible = False
Case 3
Sheets("Messe-Eingabe").Visible = True
Sheets("Messe-Berechnung").Visible = True
Sheets("Kurz-Eingabe").Visible = True
Sheets("Fin.-Anfrage").Visible = True
Sheets("Dateneingabe").Visible = True
Sheets("benötigte Unterlagen").Visible = True
End Select
End Sub
------------------------------------------------
'Tabelle per E-mail senden
Private Sub CommandButton7_Click()
Application.ShowWindowsInTaskbar = False
'Ausgabe eines Hinweistextes
Dim DateiName As String
Sheets(Array("Passwort", "Fin.-Anfrage", _
"benötigte Unterlagen", "Dateneingabe")).Copy
With ActiveWorkbook
.SaveAs "Zukunft.xls"
DateiName = .FullName
.Sheets(1).Name = "Passwort"
Sheets("Fin.-Anfrage").Visible = xlVeryHidden
Sheets("Dateneingabe").Visible = xlVeryHidden
Sheets("benötigte Unterlagen").Visible = xlVeryHidden
Application.Dialogs(189).Show "info@ifvs-gmbh.de", ActiveSheet.Name
.Close False
End With
Kill DateiName
End Sub
Vielleicht gibt es eine Möglichkeit oder hat dieses Problem schon mal gehabt.
Vielen Dank
Torge