Summe für Spalte

Sub umwandeln() Range("B2:B65536").Select Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Selection.TextToColumns Destination:=Range("B2"), DataType:=xlFixedWidth, _ FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True Selection.NumberFormat = "#,##0.00" *euer Summen-Tipp* MsgBox ("Umwandlung erfolgreich beendet!"), vbOKOnly + vbDefaultButton1 + vbInformation, "Bestätigung" End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub umwandeln() IntFactor = Val(InputBox("Bitte geben Sie das TotalVolume an.", "TotalVolume")) If IntFactor = vbDefaultButton1 Or IntFactor = "" Then GoTo Ende End If IntPass = Val(InputBox("Bitte geben Sie das Passwort für das Dokument ein.", "Passwort")) If IntPass = vbDefaultButton1 Or IntPass = "" Then GoTo Ende End If IntPass2 = Val(InputBox("Bitte wiederholen Sie das Passwort.", "Wiederholung")) If IntPass2 = vbDefaultButton1 Or IntPass2 <> IntPass Then GoTo Message End If With Range("B2:B65536") .Replace What:=".", Replacement:=",", LookAt:=xlPart .TextToColumns Destination:=Range("B2"), DataType:=xlFixedWidth, _ FieldInfo:=Array(0, 1), _ TrailingMinusNumbers:=True .NumberFormat = "#,##0.00" End With Cells(Cells(Rows.Count, 2).End(xlUp).Row + 1, 2) = _ Application.Sum(Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)) If Range("B5").Value = IntFactor Then MsgBox ("Umwandlung erfolgreich beendet!"), vbOKOnly + vbDefaultButton1 + vbInformation, "Bestätigung" ActiveSheet.Protect IntPass ChDrive "H:" ChDir "H:\Temp" Application.Dialogs(xlDialogSaveAs).Show Else MsgBox ("Fehler im Wert!"), vbOKOnly + vbDefaultButton1 + vbCritical, "Fehler" End If Ende: Exit Sub Message: MsgBox ("Sie haben entweder das falsche oder kein Wiederholungskennwort eingegeben!"), vbCritical + vbOKOnly + vbDefaultButton1, "Fehler" Exit Sub End Sub

Hi Sepp,
dass wird ja immer besser. Wie kann ich eigentlich den Code wie bei dir einfügen? Ich muss "Code" oder so etwas davor schreiben, richtig?
Ich denke, dass wird jetzt die letzte Frage zu diesem Makro sein. :) Ich habe jetzt noch eine InputBox eingefügt, die nach einem Dokumentennamen fragt. Damit wird nun der Speicherort und der Name der Datei schon vorgegeben. Anschließend würde ich die Datei gern per Mail versenden und danach schließen. Aus Testgründen habe ich diese Befehlszeilen "deaktiviert".
Leider wird der Fehler "Die Methode 'SendMail' für das Objekt '_ Workbook' ist fehlgeschlagen." ausgegeben. Kann mir jemand sagen warum?


Sub umwandeln()
Dim dblControl As Double
Dim strPass As String, strPass2 As String, XLSname As String
Dim Frage As Integer
dblControl = Application.InputBox("Bitte geben Sie das TotalVolume an.", "TotalVolume", Type:=1)
If Not IsNumeric(dblControl) Or dblControl = 0 Then Exit Sub
Name:
XLSname = InputBox("Bitte geben Sie den Dokumentnamen ein.", "Dokumentname")
If XLSname = "" Then
Frage = MsgBox("Bitte geben Sie einen Dokumentennamen ein!", vbRetryCancel + vbDefaultButton1 + vbQuestion, "Wiederholen")
If Frage = vbRetry Then
GoTo Name
Else
Exit Sub
End If
End If
strPass = InputBox("Bitte geben Sie das Passwort für das Dokument ein.", "Passwort")
If strPass = "" Then Exit Sub
strPass2 = InputBox("Bitte wiederholen Sie das Passwort.", "Wiederholung")
If strPass2 = "" Or strPass2 <> strPass Then
MsgBox ("Sie haben entweder das falsche oder kein Wiederholungskennwort eingegeben!"), 16, "Fehler"
Exit Sub
End If
With Range("B2:B65536")
.Replace What:=".", Replacement:=",", LookAt:=xlPart
.TextToColumns Destination:=Range("B2"), DataType:=xlFixedWidth, _
FieldInfo:=Array(0, 1) ', _
'TrailingMinusNumbers:=True
.NumberFormat = "#,##0.00"
End With
Cells(Cells(Rows.Count, 2).End(xlUp).Row + 1, 2) = _
Application.Sum(Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row))
If Cells(Cells(Rows.Count, 2).End(xlUp).Row, 2) = dblControl Then
MsgBox ("Umwandlung erfolgreich beendet!"), vbOKOnly + vbDefaultButton1 + vbInformation, "Bestätigung"
ActiveSheet.Protect strPass
ChDrive "H:"
ChDir "H:\Temp"
Application.Dialogs(xlDialogSaveAs).Show (XLSname)
ActiveWorkbook.SendMail _
Recipients:="xyz.xyz@xyz.de", _
Subject:="Achtung", _
ReturnReceipt:=True
'    ActiveWorkbook.Close
Else
MsgBox ("Fehler im TotalVolume!"), 16, "Fehler"
End If
End Sub

Hallo Holger!

Sub umwandeln()

Dim dblControl As Double
Dim strPass As String, strPass2 As String, strName As String
Dim Frage As Integer
Dim objWB As Workbook

dblControl = Application.InputBox("Bitte geben Sie das TotalVolume an.", "TotalVolume", Type:=1)

If Not IsNumeric(dblControl) Or dblControl = 0 Then Exit Sub

Do
  strName = InputBox("Bitte geben Sie den Dokumentnamen ein.", "Dokumentname")
  If strName = "" Then
    If MsgBox("Bitte geben Sie einen Dokumentennamen ein!", 37, "Wiederholen") <> 4 Then Exit Sub
  Else
    Exit Do
  End If
Loop

strPass = InputBox("Bitte geben Sie das Passwort für das Dokument ein.", "Passwort")
If strPass = "" Then Exit Sub

strPass2 = InputBox("Bitte wiederholen Sie das Passwort.", "Wiederholung")

If strPass2 = "" Or strPass2 <> strPass Then
  MsgBox ("Sie haben entweder das falsche oder kein Wiederholungskennwort eingegeben!"), 16, "Fehler"
  Exit Sub
End If

With Range("B2:B65536")
  .Replace What:=".", Replacement:=",", LookAt:=xlPart

  .TextToColumns Destination:=Range("B2"), DataType:=xlFixedWidth, _
    FieldInfo:=Array(0, 1), _
    TrailingMinusNumbers:=True
  .NumberFormat = "#,##0.00"
End With

Cells(Cells(Rows.Count, 2).End(xlUp).Row + 1, 2) = _
  Application.Sum(Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row))

If Cells(Cells(Rows.Count, 2).End(xlUp).Row, 2) = dblControl Then
  MsgBox ("Umwandlung erfolgreich beendet!"), vbOKOnly + vbDefaultButton1 + vbInformation, "Bestätigung"
  ActiveSheet.Protect strPass
  strName = "F:\Temp\" & strName & ".xls"
  strName = Application.GetSaveAsFilename(InitialFileName:=strName, FileFilter:="Excel Files (*.xls), *.xls")
  Set objWB = ActiveWorkbook

  With objWB
    .SaveAs (strName)
    .SendMail Recipients:="xyz.xyz@xyz.de", _
      Subject:="Achtung", _
      ReturnReceipt:=True
    .Close
  End With
Else
  MsgBox ("Fehler im TotalVolume!"), 16, "Fehler"
End If

End Sub

Software zum einfügen von Code findest du hier.
http://www.haserodt.de/cj_pro/cj_ex.php

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread