Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Fehler 440

Betrifft: Fehler 440 von: Blume
Geschrieben am: 30.09.2020 13:45:32

Hallo zusammen,

vor einiger Zeit konnte ich mit Hilfe des Forums zwei Makros vervollständigen. Die beiden funktionieren auch super, jetzt wollte ich die beiden verbunden als ein gesamtes Makro und es kommt die Fehlermeldung "Laufzeitfehler 440: Das Objekt unterstützt diese Methode nicht.".
Woran kann das liegen?
Das erste Makro übertrag bei mir nur Daten von einem Worksheet in ein anderes. Das zweite Makro exportiert aus dem zweiten ein PDF und sendet es an die Mail, die in C18 steht. Das ist auch der Punkt an dem der debugger hängen bleibt. Ich verstehe nur nicht warum es, wenn man es alleine startet funktioniert und in Kombination mit einem anderen Makro nicht. Kann mir jemand helfen?

Betrifft: AW: Fehler 440
von: Rudi Maintaire
Geschrieben am: 30.09.2020 13:56:30

Woran kann das liegen?
Am Code, woran sonst?

Dummerweise ist meine Glaskugel gerade zum Polieren weg.

Gruß
Rudi

Betrifft: AW: Fehler 440
von: Blume
Geschrieben am: 30.09.2020 14:06:52

Hier der Code: einzeln funktionieren beide, nur in dem gesmtspeichernuinfo
Sub gesamtspeichernuinfo()
'es findet den Empfänger aus der Zelle nicht
    EintragenDatenuebertragen0309
    Blatt_versenden_PDF
End Sub
und hier der einzelne Code, wo der debugger to Range C18 hängt.
Sub Blatt_versenden_PDF()
  Sheets("Blatt A").Select
  Range("B3").Select
    Selection.Copy
    Sheets("Blatt B").Select
    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Blatt A").Select
    Range("C6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blatt B").Select
    Range("C6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Blatt A").Select
    Range("C7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blatt B").Select
    Range("C7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Blatt A").Select
    Range("C8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blatt B").Select
    Range("C8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Blatt A").Select
    Range("C9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blatt B").Select
    Range("C9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Blatt A").Select
    Range("B10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blatt B").Select
    Range("B10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Blatt A").Select
    Range("C13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blatt B").Select
    Range("C13").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Blatt A").Select
    Range("C14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blatt B").Select
    Range("C14").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Blatt A").Select
    Range("C17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blatt B").Select
    Range("C17").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Blatt A").Select
    Range("C18").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blatt B").Select
    Range("C18").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Blatt A").Select
    Range("H5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blatt B").Select
    Range("H5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Blatt A").Select
    Range("H6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blatt B").Select
    Range("H6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Blatt A").Select
    Range("H7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blatt B").Select
    Range("H7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Blatt A").Select
    Range("H8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blatt B").Select
    Range("H8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
     'neu
     Sheets("Blatt A").Select
    Range("F12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blatt B").Select
    Range("H12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    Sheets("Blatt A").Select
    Range("F13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Blatt B").Select
    Range("H13").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   Sheets("Blatt B").Select
   Range("F14").Select
   
   Dim Nachricht As Object, OutApp As Object
   Set OutApp = CreateObject("Outlook.Application")
   
   Dim AWS As String, wksMail As Worksheet
   Dim print_Range_old As String
    
   Set wksMail = ActiveWorkbook.Sheets("Blatt B")
   With wksMail
      .Range("A1").Select
      AWS = Environ("UserProfile") & "\Desktop\" & Format(Date, "YYMMDD") & "_" & Range("C6") &  _
"Test" & ".pdf"
      print_Range_old = .PageSetup.PrintArea
      .PageSetup.PrintArea = "$A$1:$H$20"
      .ExportAsFixedFormat Type:=xlTypePDF, Filename:=AWS, Quality:=xlQualityStandard, _
          Ignoreprintareas:=False
      .PageSetup.PrintArea = print_Range_old
   End With
   
   Application.Visible = True
   
  Sheets("Blatt B").Select
   Set Nachricht = OutApp.CreateItem(0)
   With Nachricht
     .To = Range("C18")
     .CC = ""
     .Subject = "Übersichtsblatt Aktion " & Date & " " & Time
     .Attachments.Add AWS
     .Body = Range("C6") & "," & vbCrLf & vbCrLf & "anbei erhalten Sie das "
     .Send
   End With
   
   Kill AWS
   
   Set OutApp = Nothing
   Set Nachricht = Nothing
   
   MsgBox "Die Eingabe zur -" & Range("C6") & "- wurde erfolgreich gespeichert."
   
   'Blatt A leeren
   Sheets("Blatt A").Select
   Range("C5").Select
   Selection.ClearContents
   
   'muss wahrscheinlich noch entsperrt werden
   Sheets("Übersicht").Select
   Range("X4").Value = "x"
   Sheets("Mails versenden").Select
   Range("X3").Value = "x"
   
   'wieder ausblenden und speeren
   
   'Startseite auswählen
   Sheets("Eingabeformular").Select
   Range("C5").Select
    
   ActiveWorkbook.Save
   
End Sub


Betrifft: AW: Fehler 440
von: Daniel
Geschrieben am: 30.09.2020 14:21:23

HI
ersetze mal das Range("C18") durch einen fixe Mailadresse (am besten deine)
.to = "Max.Mustermann@MailProvider.de"

wenn das durchläuft, musst du dir die Range genauer anschauen, wenn das nicht funktioniert, liegts an deinem Mail-Objekt "Nachricht"


und kürzte bitte deinen Code, dann wird er leichter zu lesen und das macht uns Helfern das Leben einfacher.
Man muss Zellen nicht selektiern, bevor man mit ihnen was macht.
man kann auch den Befehl direkt and die Zelle dranhängen.
man muss auch das Blatt nicht selektieren, sondern man kann auch das Blatt direkt vor die Range schreiben.

ist im Prinzip so, wie wenn du aus einer Gruppe den Max Musterman zu dir rufen willst.
dann sagst du ja auch nicht "ich spreche jetzt mit Max, die Person die ich anspreche bitte herkommen", sondern du sagst "Max Mustermann, bitte herkommen".

im Code sieht das dann so aus, aus diesem Block:
 Sheets("Blatt A").Select
  Range("B3").Select
    Selection.Copy
    Sheets("Blatt B").Select
    Range("B3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

wird dann
Sheets("Blatt A").Range("B3").Copy
Sheets("Blatt B").Range("B3").PasteSpecial Paste:=xlPasteValues

(beim PasteSpecial kann man die weiteren Optionen im Code weglassen, wenn man nur ganz normal nach Standard einfügen will)
Gruß Daniel

Betrifft: AW: Fehler 440
von: Blume
Geschrieben am: 30.09.2020 14:37:00

Vielen Dank für den Tipp zum Verkürzen des Codes.

Ich habe meine Mail Adresse so in den Code eingegeben wie du es geschrieben hast, damit hat es funktioniert.
Da sich die Mail Adressen aber immer ändern, sollte es schon C18 sein.

Betrifft: Mailadresse
von: Rudi Maintaire
Geschrieben am: 30.09.2020 15:03:21

dann setz das Blatt davor.
z.B.
.to = sheets("Tabelle1").Range("C18")

Betrifft: AW: Mailadresse
von: Blume
Geschrieben am: 01.10.2020 08:18:08

Danke dir! Jetzt funktioniert es!

Betrifft: AW: Mailadresse
von: Blume
Geschrieben am: 01.10.2020 09:36:32

Ich habe noch eine weitere Frage, wäre es auch möglich, dass es nur die Mail versendet wenn in Sheet"Eingabeformluar" F13 1.000" oder 1.500 oder 2.000 steht?

Betrifft: AW: Mailadresse
von: Rudi Maintaire
Geschrieben am: 01.10.2020 16:12:05

Hallo,
ja sicher.
Select case Sheets("Eingabeformular").Range("F13")
  case 1000,1500,2000: call Blatt_versenden_PDF
End select
Gruß
Rudi

Betrifft: AW: Mailadresse
von: Blume
Geschrieben am: 02.10.2020 10:36:10

MEGA! Vielen Dank!