MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Excel
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 08.11.2018, 15:16   #1
w4schba3r
Neuer Benutzer
Neuer Benutzer
Standard VBA - Makro zum Abspeichern geht nach Update nicht mehr

Hallo zusammen,

nachdem ich bereits mehrere Stunden alles versucht habe eine Lösung zu finden wende ich mich an euch :-) Ich habe ein Makro, dass an meinem PC immer noch funktioniert, bei anderen PCs welche aber auch Office 365 (allerdings ein neueres Update) haben leider nicht mehr.

Das Makro läuft über eine einfache Oberfläche, allerdings stürzt es dann in der Sub Pruefung_abspeichern () ab und stoppt in der neu geöffnete Datei so wie im Screenshot angehangen.

Ich habe fast alles an Fehlerquellen ausgeschlossen, unter anderem, dass bei einem neu erstellten Workbook 3 Sheets erstellt werden usw.

Habt Ihr vielleicht ähnliche Probleme schon einmal im Rahmen von Updates festgestellt oder eine andere Idee woran das liegen kann?

Vielen Dank schon einmal für eure Hilfe!

Beste Grüße,

Alex

Der Code schaut wie folgt aus - der Sub der wohl den Fehler verursacht habe ich orange markiert:

Code:

Public Sub Check()

ControlCenter.History_txt = "Die KEV-Prüfung wird durchgeführt. Bitte warten... "
DoEvents

Application.ScreenUpdating = False

On Error GoTo ErrorHandling_Check

ImportGestern_abspeichern
Pruefung_starten
Pruefung_abspeichern

Application.ScreenUpdating = True

Exit Sub
ErrorHandling_Check:

ControlCenter.History_txt = "Bei der Durchführung der KEV-Prüfung ist ein Fehler aufgetreten. Bitte wenden Sie sich an den Administrator. "

End Sub

Public Sub ImportGestern_abspeichern()

Dim ZieldateiPfad As String
Dim Zieldatei As String
Dim ZieldateimitPfad As String
Dim Ta As String
Dim Mona As String
Dim Jah As String
Dim LineBottom As Double

    Sheets("ImportGestern").Select
    LineBottom = Union(Columns("A").SpecialCells(xlCellTypeLastCell), Columns("A").SpecialCells(xlCellTypeConstants)).Count - 1

Application.ScreenUpdating = False

Ta = Format(Date, "DD")
Mona = Format(Date, "MM")
Jah = Format(Date, "YYYY")

StartdateiPfad = ThisWorkbook.Path
Startdatei = ThisWorkbook.name
StartdateimitPfad = ThisWorkbook.Path & "" & ThisWorkbook.name

ZieldateiPfad = Worksheets("Data").Cells(2, 2)
Zieldatei = "KEV_Report_" & Ta & Mona & Jah & ".xls"
ZieldateimitPfad = ZieldateiPfad & "" & Zieldatei

Workbooks.Add
ActiveWorkbook.SaveAs Filename:=ZieldateimitPfad, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False

Workbooks.Open Filename:=ZieldateimitPfad
Windows(Startdatei).Activate
Sheets("ImportGestern").Select

Workbooks(Startdatei).Worksheets("ImportGestern").Range(Worksheets("ImportGestern").Cells(1, 1), Worksheets("ImportGestern").Cells(LineBottom, 13)).Copy
Workbooks(Zieldatei).Activate
ActiveSheet.Paste
ActiveWindow.Zoom = 70
Cells.EntireColumn.AutoFit

Application.DisplayAlerts = False
Workbooks(Zieldatei).Sheets("Sheet2").Select
ActiveWindow.SelectedSheets.Delete
Workbooks(Zieldatei).Sheets("Sheet3").Select
ActiveWindow.SelectedSheets.Delete

Workbooks(Zieldatei).Close SaveChanges:=True
Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub

Public Sub Pruefung_starten()

Dim i As Double
Dim k As Double
Dim Anzahl_Gestern As Double
Dim Anzahl_Vorgestern As Double
Dim MAX_zeilen As Double

Anzahl_Gestern = Worksheets("ImportGestern").UsedRange.Rows.Count - 1
Anzahl_Vorgestern = Worksheets("ImportVorgestern").UsedRange.Rows.Count - 1

MAX_zeilen = Application.WorksheetFunction.Max(Anzahl_Gestern, Anzahl_Vorgestern)

Abweichung = 0
i = 3
Do Until i > MAX_zeilen

    k = 1
    Do Until k > 13
        If Worksheets("ImportGestern").Cells(i, k).Value = Worksheets("ImportVorgestern").Cells(i, k).Value Then
            Worksheets("ImportGestern").Cells(i, k).Interior.ColorIndex = 35
        Else
            Worksheets("ImportGestern").Cells(i, k).Interior.ColorIndex = 40
            Abweichung = Abweichung + 1
        End If


    k = k + 1
    Loop
i = i + 1
Loop

End Sub

Public Sub Pruefung_abspeichern()

Dim ZieldateiPfad As String
Dim Zieldatei As String
Dim ZieldateimitPfad As String
Dim Ta As String
Dim Mona As String
Dim Jah As String
Dim LineBottom As Double

    Sheets("ImportGestern").Select
    LineBottom = Union(Columns("A").SpecialCells(xlCellTypeLastCell), Columns("A").SpecialCells(xlCellTypeConstants)).Count - 1

Application.ScreenUpdating = False

Ta = Format(Date, "DD")
Mona = Format(Date, "MM")
Jah = Format(Date, "YYYY")

StartdateiPfad = ThisWorkbook.Path
Startdatei = ThisWorkbook.name
StartdateimitPfad = ThisWorkbook.Path & "" & ThisWorkbook.name

ZieldateiPfad = Worksheets("Data").Cells(3, 2)
Zieldatei = "KEV_Report_LIQ_" & Ta & Mona & Jah & ".xls"
ZieldateimitPfad = ZieldateiPfad & "" & Zieldatei

Workbooks.Add
ActiveWorkbook.SaveAs Filename:=ZieldateimitPfad, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False

Workbooks.Open Filename:=ZieldateimitPfad
Windows(Startdatei).Activate
Sheets("ImportGestern").Select

Workbooks(Startdatei).Worksheets("ImportGestern").Range(Worksheets("ImportGestern").Cells(1, 1), Worksheets("ImportGestern").Cells(LineBottom, 13)).Copy
Workbooks(Zieldatei).Activate
ActiveSheet.Paste
ActiveWindow.Zoom = 70
Cells.EntireColumn.AutoFit

Application.DisplayAlerts = False
Workbooks(Zieldatei).Sheets("Sheet2").Select
ActiveWindow.SelectedSheets.Delete
Workbooks(Zieldatei).Sheets("Sheet3").Select
ActiveWindow.SelectedSheets.Delete

Workbooks(Zieldatei).Close SaveChanges:=True
Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub
Angehängte Grafiken
Dateityp: jpg Screenshot.JPG (67,4 KB, 7x aufgerufen)
w4schba3r ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.11.2018, 16:05   #2
EarlFred
MOF Guru
MOF Guru
Standard

(1) erläuterte dem unbedarften Leser bitte folgende Codezeile:
Code:

ControlCenter.History_txt = "Die KEV-Prüfung wird durchgeführt. Bitte warten... "
Die Zeile mag nicht relevant sein, aber wenn Du hier Code zur Analyse postest, sollte er auch analysierbar sein.

(2)
Code:

Workbooks.Add
ActiveWorkbook.SaveAs Filename:=ZieldateimitPfad, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False

Workbooks.Open Filename:=ZieldateimitPfad
Windows(Startdatei).Activate
Sheets("ImportGestern").Select
Im 2. Code brauchst Du nicht erklären, was jede Zeile tut. Mich interessiert vielmehr: Warum hast Du diesen Ablauf gewählt?


(3)
Code:

Workbooks(Startdatei).Worksheets("ImportGestern").Range(Worksheets("ImportGestern").Cells(1, 1), Worksheets("ImportGestern").Cells(LineBottom, 13)).Copy
Workbooks(Zieldatei).Activate
ActiveSheet.Paste
ActiveWindow.Zoom = 70
Cells.EntireColumn.AutoFit
Vergleiche hier bitte Zeile 1 und die restlichen Zeilen miteinander.
In Zeile 1 versuchst Du, sauber zu referenzieren, das gelingt allerdings nicht durchgehend. Siehst Du, warum?
Was ist der Unterschied zwischen ThisWorkbook und Workbooks(Startdatei)?
Warum versuchst Du es in den anderen Zeilen nicht?

Same here:
Code:

Application.DisplayAlerts = False
Workbooks(Zieldatei).Sheets("Sheet2").Select
ActiveWindow.SelectedSheets.Delete
Workbooks(Zieldatei).Sheets("Sheet3").Select
ActiveWindow.SelectedSheets.Delete
Was bezweckst Du mit dem "Select"? Warum verwendest Du nicht eine Programmierweise, wie Du sie in Codebeispiel (3), Zeile 1 versucht hast?

Was den Fehler genau verursacht, kann ich Dir nicht sagen. Aber zumindest würde ich den Code erstmal sauber programmieren. Gute Ansätze sind da, arbeite weiter daran!

Danach machst Du Dich auf die Fehlersuche.

__________________

Datum und Uhrzeit, Makrorekorder-Code entschlacken, {Matrixformeln}
Tutorials zu Pivottabellen: Kurzeinstieg; Dynamischer Datenbereich; Daten und Zeiten gruppieren
Für 6 meiner Beiträge haben sich die Hilfesuchenden mit einer Spende an Wikipedia, die Tafeln oder Hilfe für krebskranke Kinder eV bedankt (das entspricht 0,044% per 26.07.2018) - eine tolle Geste!

Geändert von EarlFred (08.11.2018 um 16:39 Uhr).
EarlFred ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.11.2018, 16:10   #3
EarlFred
MOF Guru
MOF Guru
Standard

Hier mal ein Beispiel, das ich vor kurzem gepostet habe:
(https://www.ms-office-forum.net/foru...83&postcount=2)

Schau Dir an, wie es anders geht (das kann noch optimiert werden, aber um die Möglichkeiten zu erkunden sollte es taugen)
Code:

Option Explicit

Sub DateiMitMonatenAnlegen()

Dim i As Long
Dim lngShInNewWB As Long

lngShInNewWB = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 12

With Workbooks.Add
  For i = 1 To 12
    .Worksheets(i).Name = Application.Text(DateSerial(2018, i, 1), "[$-409]MMMM")
  Next i
End With
Application.SheetsInNewWorkbook = lngShInNewWB

End Sub
VBA kennt Objekte - und Du verwendest sie (möglicherweise ohne es zu wissen). Nutze sie bewusst - vor allem die Möglichkeiten.

__________________

Datum und Uhrzeit, Makrorekorder-Code entschlacken, {Matrixformeln}
Tutorials zu Pivottabellen: Kurzeinstieg; Dynamischer Datenbereich; Daten und Zeiten gruppieren
Für 6 meiner Beiträge haben sich die Hilfesuchenden mit einer Spende an Wikipedia, die Tafeln oder Hilfe für krebskranke Kinder eV bedankt (das entspricht 0,044% per 26.07.2018) - eine tolle Geste!
EarlFred ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.11.2018, 16:54   #4
Luschi
MOF Koryphäe
MOF Koryphäe
Standard

Hallo ,

mit der Verwendung von SpecialCells(xlCellTypeConstants) bin ich sehr vorsichtig und vermeide es meistes, denn da kommt oft Blödsinn raus.
Wenn in einer Tabelle nur die Zellen 'A4:A9' und 'A17' sowie 'K1' einen Wert enthalten, dann ergibt:
- Range("A1:A100").SpecialCells(xlCellTypeLastCell) die Zelle 'K17' und nicht 'A17'
- obwohl in der Vba-Hilfe steht:
- xlCellTypeLastCell. Die letzte Zelle im verwendeten Bereich

Und das kann auch hier passieren:
Code:

LineBottom = Union(Columns("A").SpecialCells(xlCellTypeLastCell), Columns("A").SpecialCells(xlCellTypeConstants)).Count - 1
Gruß von Luschi
aus klein-Paris

PS: getestet mit Excel 2013, 2016, 2019
Außerdem löst 'SpecialCells(xlCellTypeLastCell)' die Ereignisse aus
- Worksheet_SelectionChange und
- Workbook_SheetSelectionChange
Luschi ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 09.11.2018, 08:33   #5
w4schba3r
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hallo zusammen,

vielen Dank für die Zeit dir Ihr euch genommen habt und die super Ratschläge! Ich werde vermutlich heute Nachmittag etwas Zeit haben noch einmal das Makro anzupassen und werde mich noch einmal melden falls sich das Problem lösen lässt. Komisch ist immer noch, dass das das Makro an meinem PC durchläuft nur an anderen PCs nicht..

Beste Grüße,

Alex
w4schba3r ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 01:13 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.