Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
30.11.2020 10:30:08 |
Doris |
|
|
|
30.11.2020 11:28:15 |
volti |
|
|
|
01.12.2020 09:02:34 |
Doris |
|
|
|
01.12.2020 10:31:04 |
volti |
|
|
|
01.12.2020 12:44:17 |
Doris |
|
|
|
01.12.2020 13:03:46 |
volti |
|
|
|
01.12.2020 13:42:20 |
Doris |
|
|
|
01.12.2020 14:27:06 |
volti |
|
|
|
01.12.2020 14:49:35 |
Doris |
|
|
Fortlaufende Nummerierung beim versenden der Datei |
01.12.2020 14:50:57 |
volti |
|
|
|
01.12.2020 14:53:04 |
volti |
|
|
|
01.12.2020 15:17:30 |
Doris |
|
|
|
01.12.2020 15:43:34 |
Doris |
|
|
|
01.12.2020 15:55:39 |
Doris |
|
|
|
01.12.2020 16:17:43 |
volti |
|
|
|
01.12.2020 16:26:36 |
Doris |
|
|
|
01.12.2020 16:41:38 |
Doris |
|
|
|
01.12.2020 17:25:56 |
Doris |
|
|
Von:
volti |
Datum:
01.12.2020 14:50:57 |
Views:
466 |
Rating:
|
Antwort:
|
Thema:
Fortlaufende Nummerierung beim versenden der Datei |
Hier noch ein Vorschlag in Anlehung an Dein Script:
Option Private Module
Sub Absenden()
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object
Dim MsgTxt As String
'Vollständigkeitsprüfung
If Tabelle1.Range("E20").Value = "" Then
MsgTxt = "Zelle Baubeginn ist leer. Tragen Sie den Baubeginn ein!"
ElseIf Tabelle1.Range("E22").Value = "" Then
MsgTxt = "Zelle Bauende ist leer. Tragen Sie das voraussichtliche Bau-Ende ein!"
ElseIf Tabelle1.Range("E24").Value = "" Then
MsgTxt = "Zelle Budgetierte Bausumme (EUR) ist leer. Tragen Sie einen Wert ein!"
ElseIf Tabelle1.Range("E26").Value = "" Then
MsgTxt = "Zelle Tochtergesellschaft ist leer. Tragen Sie einen Wert ein!"
End If
If MsgTxt <> "" Then
MsgBox MsgTxt, vbCritical, "Prüfung"
ActiveSheet.Protect Password:=""
Exit Sub
End If
ActiveSheet.Unprotect Password:=""
On Error Resume Next
Set Source = Range("A1:I27").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Err = 0 Then
[G4] = [G4] + 1
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With
TempFilePath = Environ$("temp") & "\"
TempFileName = "Selection of " & wb.Name & " " _
& Format(Now, "dd-mmm-yy h-mm-ss")
If Val(Application.Version) < 12 Then
'You use Excel 2000-2003
FileExtStr = ".xlsx": FileFormatNum = -4143
Else
'You use Excel 2007-2010
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.GetInspector
.To = "irgendeinmail@weisnicht.de"
.CC = ""
.BCC = ""
.Subject = "Projekt"
.Body = "Bauprojekt" & vbCrLf & .Body
.Attachments.Add Dest.FullName
.Display
End With
On Error GoTo 0
.Close SaveChanges:=False
End With
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
ActiveSheet.Protect Password:=""
End Sub
VG KH
|
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
30.11.2020 10:30:08 |
Doris |
|
|
|
30.11.2020 11:28:15 |
volti |
|
|
|
01.12.2020 09:02:34 |
Doris |
|
|
|
01.12.2020 10:31:04 |
volti |
|
|
|
01.12.2020 12:44:17 |
Doris |
|
|
|
01.12.2020 13:03:46 |
volti |
|
|
|
01.12.2020 13:42:20 |
Doris |
|
|
|
01.12.2020 14:27:06 |
volti |
|
|
|
01.12.2020 14:49:35 |
Doris |
|
|
Fortlaufende Nummerierung beim versenden der Datei |
01.12.2020 14:50:57 |
volti |
|
|
|
01.12.2020 14:53:04 |
volti |
|
|
|
01.12.2020 15:17:30 |
Doris |
|
|
|
01.12.2020 15:43:34 |
Doris |
|
|
|
01.12.2020 15:55:39 |
Doris |
|
|
|
01.12.2020 16:17:43 |
volti |
|
|
|
01.12.2020 16:26:36 |
Doris |
|
|
|
01.12.2020 16:41:38 |
Doris |
|
|
|
01.12.2020 17:25:56 |
Doris |
|
|