Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1596to1600
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

XLSX ohne Makros speichern

XLSX ohne Makros speichern
18.12.2017 23:07:56
Sabrina
Hallo liebes Forum,
vor vielen Jahren habe ich Dank dieses Forums ein gut funktionierendes Projekt erstellenh können. Die Version war Excel 2003 = xlt
Rechnungsvorlage ist xlt, per Button wird diese als xls geöffnet. Beim Drucken wird eine fortlaufende Rechnungsnummer vergeben und relevante Daten werden in eine separate Tabelle untereinander geschrieben. Funktioniert einwandfrei.
Nun muss ich diese Vorlage als .xlsm abspeichern. Das Öffnen als .xlsx kriege ich per Makro noch hin (aufgezeichnet) aber beim Speichern erscheint die Meldung "... Die folgenden Features können in Arbeitsmappen ohne Makros nicht gespeichert werden:
• VB Projekt ..."
Ich habe versucht, die Meldung mit: Application.DisplayAlerts = False zu unterdrücken, aber es funktioniert einfach nicht.
Ich weiß einfach nicht, wie ich den Code ändern muss. Könnt ihr mir bitte helfen?
Vielen Dank schon mal
VG Sabrina
Option Explicit
Private Sub Workbook_Open() 'Rechnung
ChDir "C:\Vorlagen"
Workbooks.Open FileName:="C:\Vorlagen\Tabelle.xls"
Windows(1).Activate
Dim myWorksheet As Worksheet 'Passwort aufheben und Formatierungen zulassen
For Each myWorksheet In ThisWorkbook.Worksheets
myWorksheet.Protect Password:="meier", UserInterFaceOnly:=True, DrawingObjects:=True,  _
Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowInsertingRows:=True, AllowDeletingRows _
:=True
ActiveSheet.EnableSelection = xlUnlockedCells
Next
Dim Datum As String
Datum = Format(Now, "dd.mm.yyyy")
Range("F12") = Datum
End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean)
On Error GoTo R_Error
Dim newNr As Variant, oldNr As Variant
Dim FileName As String
FileName = "C:\Rechnung.ini"
If Range("B14")  "" Then Exit Sub
Close #1
restart:
Open FileName For Input As #1
Line Input #1, oldNr
Close #1
newNr = oldNr + 1
Open FileName For Output As #1
Write #1, newNr
Close #1
Select Case Len(newNr)
Case 1
newNr = "000" & newNr
Case 2
newNr = "00" & newNr
Case 3
newNr = "0" & newNr
Case 4
newNr = newNr
Case 5
MsgBox "Zahlenlimit überschritten"
Exit Sub
End Select
Range("B14") = newNr & "-17 A"
R_Exit:
Exit Sub
R_Error:
Select Case Err
Case 53
Open FileName For Output As #1
Close #1
Open FileName For Output As #1
Write #1, 0
Close #1
Err.Clear
Resume restart
Case 54
Close #1
Resume restart
Case Else
MsgBox Err & ": " & Err.Description
Resume R_Exit
End Select
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Workbooks("Tabelle.xls").Activate
ActiveWorkbook.Worksheets("Tabelle1").Unprotect "mueller"
Windows(1).Activate
If Range("B14")  "" Then
Dim wksSource As Worksheet, wksTarget As Worksheet
Dim iRow As Integer
Dim chkStr As String
Set wksSource = Worksheets("Rechnung")
Set wksTarget = Workbooks("Tabelle.xls").Worksheets(1)
chkStr = wksSource.Range("A11").Value
iRow = wksTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1
wksTarget.Cells(iRow, 1).Value = wksSource.Range("B14").Value
wksTarget.Cells(iRow, 2).Value = wksSource.Range("F12").Value
wksTarget.Cells(iRow, 5).Value = wksSource.Range("B18").Value
wksTarget.Cells(iRow, 6).Value = wksSource.Range("B17").Value
wksTarget.Cells(iRow, 7).Value = wksSource.Range("F18").Value
wksTarget.Cells(iRow, 8).Value = wksSource.Range("F30").Value
wksTarget.Cells(iRow, 9).Value = wksSource.Range("F13").Value
wksTarget.Cells(iRow, 3).Value = Left(chkStr, InStr(1, chkStr, Chr$(10)) - 1)
chkStr = Right(chkStr, Len(chkStr) - InStr(1, chkStr, Chr$(10)))
wksTarget.Cells(iRow, 4).Value = Left(chkStr, InStr(1, chkStr, Chr$(10)) - 1)
End If
Workbooks("Tabelle.xls").Activate
ActiveWorkbook.Worksheets("Tabelle1").Protect "mueller"
ActiveWorkbook.Close SaveChanges:=True
If ThisWorkbook.Name = "Rechnung.xlt" Then
Exit Sub
Else
Dim vbc As Object
With ActiveWorkbook.VBProject
For Each vbc In .VBComponents
Select Case vbc.Type
Case 1, 2, 3: .VBComponents.Remove .VBComponents(vbc.Name)
Case 100
With vbc.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next
End With
End If
End Sub

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
einfach als .xltm speichern
19.12.2017 01:10:44
guenni
.. das neue Vorlagenformat mit Makros
AW: einfach als .xltm speichern
19.12.2017 09:44:46
Sabrina
Hallo Guenni,
auch wenn ich die Vorlage als XLTM-Datei speicher, erscheint die Meldung bzgl. des "VB Projekt..."
VG
Sabrina
AW: einfach als .xltm speichern
19.12.2017 09:57:17
guenni
Dann benutzt Du nicht das Pulldown für die Dateitypen, sondern gibst Die Endung ins Dateinamenfeld ein!
AW: einfach als .xltm speichern
19.12.2017 10:10:23
Sabrina
Hallo Guenni,
die ehemalige XLT-Datei hatte ich geöffnet und mit Speichern unter als XLTM oder XLSM (beides ausprobiert) gespeichert.
Über NEU öffnet er XLSX und die Vorgabe beim Speichern ist entsprechend auch XLSX, allerdings mit Abfrage bzgl. der Makros.
VG
Sabrina
AW: einfach als .xltm speichern
19.12.2017 12:04:33
Sabrina
Hallo Günther,
ich möchte OHNE Makros, und zwar als XLSX speichern.
Dennoch, danke für deine Mühe.
VG
Sabrina
.....und wieso....
19.12.2017 20:20:18
STeve
...speicherst du es nicht als xlsx ohne Makros ab? .... VBA Editor öffnen alle Module und Codes löschen, dann abspeichern. ....oder steh ich auf dem Schlauch?..... STeve
AW: .....und wieso....
19.12.2017 21:46:21
Sabrina
Hallo Steve,
wenn die Vorlage als XLSX geöffnet wird, sind die Makros vorhanden, um z.B. Rechnungsnr. etc. einzufügen. Wenn die Rechnung gespeichert wird, kommt natürlich die Meldung bzgl. Makros gehen verloren ...
Ich kann meinen Mädels nicht zumuten, dass sie jedesmal die Meldung mit JA bestätigen bzw. die Makros von Hand löschen.
Am Tag werden viele kleine Rechnungen von verschiedenen Mitarbeiterinnen geschrieben und deswegen möchte ich gerne, dass Excel die Makros automatisch löscht, wenn die Rechnung geschlossen wird.
In der alten Version klappte das ja.
VG
Sabrina
Anzeige
Dieses Update wird nicht spurlos an Dir voübergehn
20.12.2017 10:24:05
guenni
Das klappte wohl kaum.
In der alten Version hast Du mit an Sicherheit grenzender Wahrscheinlichkeit incl. Makros gespeichert.
Nur dass die Unterscheidung in mit/ohne Makros nicht an der Dateiendung ersichtlich war.
Würde den Code in ein Add-in auslagern
Da nun mal diese strikte Unterscheidung mit/ohne Makros eingeführt ist, macht man das Beste draus.
m.E. hast Du die Wahl zwischen
- Einstieg in AddIn-Programmierung
- Den Mitarbeiterinnen die Dialogbox zumuten
- Vorlage als xlsm schreibgeschützt bereitstellen und Weiterverarbeitung als xlsm
Anzeige
versuche mal Screenupdating und DisplayAlerts -
20.12.2017 15:29:30
STeve

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Workbooks("Tabelle.xls").Activate
ActiveWorkbook.Worksheets("Tabelle1").Unprotect "mueller"
Windows(1).Activate
If Range("B14")  "" Then
Dim wksSource As Worksheet, wksTarget As Worksheet
Dim iRow As Integer
Dim chkStr As String
Set wksSource = Worksheets("Rechnung")
Set wksTarget = Workbooks("Tabelle.xls").Worksheets(1)
chkStr = wksSource.Range("A11").Value
iRow = wksTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1
wksTarget.Cells(iRow, 1).Value = wksSource.Range("B14").Value
wksTarget.Cells(iRow, 2).Value = wksSource.Range("F12").Value
wksTarget.Cells(iRow, 5).Value = wksSource.Range("B18").Value
wksTarget.Cells(iRow, 6).Value = wksSource.Range("B17").Value
wksTarget.Cells(iRow, 7).Value = wksSource.Range("F18").Value
wksTarget.Cells(iRow, 8).Value = wksSource.Range("F30").Value
wksTarget.Cells(iRow, 9).Value = wksSource.Range("F13").Value
wksTarget.Cells(iRow, 3).Value = Left(chkStr, InStr(1, chkStr, Chr$(10)) - 1)
chkStr = Right(chkStr, Len(chkStr) - InStr(1, chkStr, Chr$(10)))
wksTarget.Cells(iRow, 4).Value = Left(chkStr, InStr(1, chkStr, Chr$(10)) - 1)
End If
Workbooks("Tabelle.xls").Activate
ActiveWorkbook.Worksheets("Tabelle1").Protect "mueller"
ActiveWorkbook.Close SaveChanges:=True
If ThisWorkbook.Name = "Rechnung.xlt" Then
Exit Sub
Else
          Rem Bildschirmmeldung deaktivieren
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Dim vbc As Object
With ActiveWorkbook.VBProject
For Each vbc In .VBComponents
Select Case vbc.Type
Case 1, 2, 3: .VBComponents.Remove .VBComponents(vbc.Name)
Case 100
With vbc.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next
End With
End If
                      With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With

End Sub

..in fett.....Bildschirmupdating und DisplayAlerts - deaktivieren und ganz unten wieder aktivieren.
mfg STeve
Anzeige
AW: versuche mal Screenupdating und DisplayAlerts -
20.12.2017 15:34:20
STeve
.........unten natürlich auf True stellen.......

With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With

mfg STeve
Versuch passt perfekt!
20.12.2017 23:16:44
Sabrina
Hallo STeve,
ich habe die "Application" Zuhause an meiner Testdatei eingefügt und es funktioniert. Bin überglücklich.
Morgen dann an die "Echtdaten", denke aber, auch dort wird es funktionieren.
Ich danke euch Zwei ganz herzlich für die Mühe und die Zeit.
Wünsche euch und allen anderen Foristen ein schönes Weihnachtsfest.
VG
Sabrina
Fein und...
21.12.2017 09:28:33
STeve
..hoffe klappt auch bei den Echtdaten. Danke und dir auch schöne Weihnachten. Mfg STeve
Anzeige

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige