Makro Excel 2011 umstieg auf Office365

nanobottom

Neues Mitglied
Thread Starter
Dabei seit
13.10.2019
Beiträge
10
Reaktionspunkte
0
Guten Tag erstmal. Suche Hilfe hier bevor ich durchdrehe. Sehe den Fehler nicht.
Habe bis heute auf der Mac OS Plattform Excel 2011 zum laufen gehabt und die Makros
haben ihren Dienst getan, bis ich jetzt auf Catalina OS Version umgesattelt bin und somit
keine 32bit Unterstützung mehr gab. Also Neuestes Office installiert und folgende Makros
werden nicht korrekt ausgeführt: Speicherung mit Name aus Spalte D7 wird mit Laufzeitfehler 1004 mit
der Anmerkung das ich keine Berechtigung besitze es an diesem Ort zu speichern... des Weiteren
stürzt er ab beim Druckmakro.
makro.bas hat folgenden Inhalt:

Attribute VB_Name = "Modul1"
Sub Speichern_BeiKlick()
If Range("D1") = "" Then
MsgBox "Fehler! Eingabe des Datum`s fehlt! " If Range("D1") = "" Then GoTo FINI
End If
If ActiveWorkbook.Name = "Eingabe.xls" Then Dim dName$
Dim dS$
dName = Worksheets(1).Range("D1") & (".xls") dS = ThisWorkbook.Path & ":Nachweise:" & dName ActiveWorkbook.SaveAs dS
End If
If ActiveWorkbook.Name <> "Eingabe.xls" Then Dim dName1$
Dim dS1$
dName1 = Worksheets(1).Range("D1") & (".xls") dS1 = ThisWorkbook.Path & ":" & dName1 ActiveWorkbook.SaveAs dS1
End If
FINI:
End Sub
Sub Drucken_BeiKlick()
If ActiveWorkbook.Name = "Eingabe.xlsx" Then
MsgBox "Drucken nicht möglich ohne vorher zu speichen!" End If
If ActiveWorkbook.Name = "Eingabe.xls" Then GoTo FINI
Dim x$
If Range("A7") = "" Then GoTo FINI
If Range("A7") > "" Then x = 1 If Range("B36") > "" Then x = 2 If Range("B71") > "" Then x = 3 If Range("B106") > "" Then x = 4 If Range("B141") > "" Then x = 5 If Range("B176") > "" Then x = 6
ActiveSheet.PageSetup.PrintArea = "Druckbereich" ActiveWindow.SelectedSheets.PrintOut From:=1, To:=x, Copies:=1, Collate _ :=True
ActiveWindow.View = xlNormalView
FINI:
End Sub
Sub auto_open()
Application.DisplayFullScreen = True Application.DisplayFormulaBar = False CommandBars("Worksheet Menu Bar").Enabled = False End Sub

Sub Beenden_close()

If ActiveWorkbook.Name = "Eingabe.xls" Then GoTo nr1 If ActiveWorkbook.Name <> "Eingabe.xls" Then GoTo nr2
nr1:
Application.DisplayFullScreen = True CommandBars("Worksheet Menu Bar").Enabled = False Application.DisplayFormulaBar = False Application.DisplayAlerts = True ThisWorkbook.Close Saved = True
GoTo ENDE
nr2:
Application.DisplayFullScreen = True CommandBars("Worksheet Menu Bar").Enabled = True Application.DisplayFormulaBar = True Application.DisplayAlerts = False ThisWorkbook.Close Savechanges:=True
GoTo ENDE
ENDE: End Sub


Also so sieht er aus und danke im Voraus schon mal!

Mit freundlichen Grüßen nanobottom
 
Hallo Peter ... danke erstmal ... ich muss komplett umdenken und es Schritt für Schritt mal durchgehen ....
was für die Winterzeit :)
aber danke ....

nanobottom
 
danke erstmal ... ich muss komplett umdenken und es Schritt für Schritt mal durchgehen
Mit meinem leider nur eingeschränkten Wissen über VBA befürchte ich, dass dir das Sandboxing unter macOS die Berechtigungsfehler produziert. Träfe das zu, wäre dann vermutlich die Aufgabe, den Speichervorgang aus dem Makro heraus kompatibel zu machen.
 
Hallo fa66
hatte es geschafft das er es auf oberste Ebene speicherte aber es blieb insgesamt fehlerhaft und die Abstürze machen nicht gerade einfach und ich muss erst einmal mit den gravierenden Veränderungen von 2011 und 2019 klarkommen da sich vieles verändert hat wie z.B. konnte man 2011 noch Makros in einer .xls Datei haben und 2019 bei .xlsx Datei nicht ... da kommt .xmls ins Spiel.
Denke es ist nicht nur ein Fehler sondern ein Paar aber irgendwann sieht man den Wald vor lauter Bäume nicht und da ist es ratsam andere Augen und Gehirne mit ins Boot zu ziehen :)
aber Danke...

Mit freundlichen Grüßen nanobottom
 
hallo .. ich habe jetzt als Endung .xlsm aber er quittiert mir es mit ein Microsoft Visual Basic 400 ?? Also wenn ich in D1 was eintrage erscheint es PopUp Message funzt ...


#######################
Sub Speichern_BeiKlick()
If Range("D1") = "" Then
MsgBox "Fehler! Eingabe des Datum`s fehlt! " If Range("D1") = "" Then GoTo FINI
End If
If ActiveWorkbook.Name = "Eingabe.xls" Then Dim dName$
Dim dS$
dName = Worksheets(1).Range("D1") & (".xls") dS = ThisWorkbook.Path & ":Nachweise:" & dName ActiveWorkbook.SaveAs dS
End If
If ActiveWorkbook.Name <> "Eingabe.xls" Then Dim dName1$
Dim dS1$
dName1 = Worksheets(1).Range("D1") & (".xls") dS1 = ThisWorkbook.Path & ":" & dName1 ActiveWorkbook.SaveAs dS1
End If
FINI:
End Sub

#######################
 
z.B. konnte man 2011 noch Makros in einer .xls Datei haben und 2019 bei .xlsx Datei nicht
Das ist so gewollt. Sollen Makros in eine Arbeitsmappe unter OpenXML, lautet die Dateinamenerweiterung *.xlsm.

*.xlsx (wie auch *.docx und *.pptx) verhindern das Speichern von Makros, bzw. bei etwaigem späteren Umbenennen einer Datei im Finder oder Explorer, das Ausführen von Makros durch Excel.
Es ist auch nix Neues. Seit MSO2007 verhindern OpenXML-formatige MSO-Dateien das als Sicherheitsmerkmal. Im Excel97-2004-Format gab es diesen Unterschied in *.xls nicht.

Zum eigentlichen VBA-Code kann ich leider nicht helfen.
 
Bei folgenden Druck_Makros wird nicht der Range gedruckt sondern der Gesamte Druckbereich (in meinem Fall alle 6 Seiten sprich Range A1:J196)
es soll wie gesagt nur der angegebene Range ausgedruckt werden. Beide führen zum selben nicht erwünschten Erfolg ...
Benutzt wird Excel 2019


Sub DruckeBereich_1()
Range("A1:J37").PrintOut Copies:=1
End Sub

Sub DruckeBereich_2()

Sheets("Blatt1").Range("A1:J74").PrintOut Copies:=1

End Sub
 
Hab Fehler korrigiert aber er druckt bei beiden auch alle 6 Seiten aus sprich nicht den Range der Angegeben ist.



@noodyn

zum 2.:
Index außerhalb des definierten Bereichs.

zum 1.:
Fehler beim Kompilieren.:
"Sub" oder "Function" ist nicht definiert.
 
Also ... dies hat bis zur office Version 2011 funktioniert aber seit Catalina werden keine 32bit mehr unterstützt.
Bei der Version 2019 habe ich es abgeändert natürlich in einer .xlsm Datei aber es stürzt ab ...
Ich möchte erreichen das er mir nicht alle 6 ausdrucken tut sonder wie angegeben nur die wo was auch drin steht.
Bitte um Hilfe da ansonsten der halbe Regenwald neben meiner Rundablage liegt.

Sub Drucken_BeiKlick()
If ActiveWorkbook.Name = "Eingabe.xlsm" Then
MsgBox "Drucken nicht möglich ohne vorher zu speichen!" End If

If ActiveWorkbook.Name = "Eingabe.xlsm" Then GoTo FINI
Dim x$
If Range("A7") = "" Then GoTo FINI
If Range("A7") > "" Then x = 1
If Range("B36") > "" Then x = 2
If Range("B71") > "" Then x = 3
If Range("B106") > "" Then x = 4
If Range("B141") > "" Then x = 5
If Range("B176") > "" Then x = 6

ActiveSheet.PageSetup.PrintArea = "Druckbereich" ActiveWindow.SelectedSheets.PrintOut From:=1, To:=x, Copies:=1, Collate _ :=True
ActiveWindow.View = xlNormalView
FINI:
End Sub
 
So sieht meine vorläufige Lösung aus die zwar funktioniert aber halt nicht so komfortabel wie zuvor...
Neuerungen sind halt nicht immer gut :) vielleicht hat jemand bessere Lösung .....
Mit freundlichen Grüßen

Sub Beenden_close()

If ActiveWorkbook.Name = "Eingabe.xlsm" Then GoTo nr1
If ActiveWorkbook.Name <> "Eingabe.xlsm" Then GoTo nr2
nr1:
Application.DisplayFullScreen = True
CommandBars("Worksheet Menu Bar").Enabled = False
Application.DisplayFormulaBar = False
Application.DisplayAlerts = True
ThisWorkbook.Close Saved = True
GoTo Ende
nr2:
Application.DisplayFullScreen = True
CommandBars("Worksheet Menu Bar").Enabled = True
Application.DisplayFormulaBar = True
Application.DisplayAlerts = False
ThisWorkbook.Close Savechanges:=True
GoTo Ende

Ende: End Sub


Sub Speichern_neu()

If Range("D1") = "" Then
MsgBox "Fehler! Eingabe des Datums fehlt!"
If Range("D1") = "" Then GoTo FINI

End If

ActiveWorkbook.SaveAs ThisWorkbook.Path & Range("D1") & (".xlsm")


FINI:
Ende: End Sub


Sub Druckdialog()

If ActiveWorkbook.Name = "Eingabe.xlsm" Then
MsgBox "Drucken nicht möglich ohne vorher zu speichern!"
End If

If ActiveWorkbook.Name = "Eingabe.xlsm" Then GoTo FINI


Application.Dialogs(xlDialogPrint).Show

FINI:
End Sub
 
folgendes probiere ich beim speichern:

Sub Speichern_BeiKlick1()
If Range("D1") = "" Then
MsgBox "Fehler! Datum fehlt! "
If Range("D1") = "" Then GoTo FINI
End If
If ActiveWorkbook.Name = "Eingabe.xlsm" Then
Dim dName$
Dim dS$
dName = Worksheets(1).Range("D1") & (".xlsm")
dS = ThisWorkbook.Path & ":Nachweise:" & dName
ActiveWorkbook.SaveAs dS
End If
If ActiveWorkbook.Name <> "Eingabe.xlsm" Then
Dim dName1$
Dim dS1$
dName1 = Worksheets(1).Range("D1") & (".xlsm")
dS1 = ThisWorkbook.Path & ":" & dName1
ActiveWorkbook.SaveAs dS1

End If
FINI:
End Sub

Als Antwort gibts folgendes:

Bildschirmfoto 2019-10-20 um 18.23.00.png


Wäre nett wenn jemand einen Vorschlag hat ... Danke
 
In welchem Pfad liegt den die VBA-Anwendung – und in welchen Pfad versucht diese zu speichern?
Also von wo aus versucht sie wohin zu speichern?
 
Die Eingabe.xlms befindet sich im Verzeichnis Test der sich auf dem Desktop wiederum befindet und darin befindet sich das Verzeichnis Nachweise.

Bei der zuvor nicht zufriedenstellenden Lösung speichert er es ab auf dem Desktop ab und wenn ich diese dann verschiebe immer eine Ebene höher wo sie sich dann befindet und zwingt mich die Berechtigung zu erteilen aber bei der zweiten Variante nicht ,,,
 
Zurück
Oben Unten