|
Hallo,
ich habe eine Arbeitsmappe wo ich mir mittels Sverweis diverse Produktdaten aus einem Zentralen Excel hole (wie z.B. Preise). Ich habe einen
Button eingebaut mit dem ich das Excel für "Externe" speichern kann in dem die Sverweise und Formeln durch Werte ersetzt werden. Soweit
funktioniert das. Jetzt habe ich aber gesehen, dass der VBA-Code darin enthalten bleibt.
Ich möchte nun auch noch diesen Code beim abspeichern ohne Rückfrage entfernen. Geht das????
Hier der Code:
Sub Speichern_EPG()
Dim ord As String
Dim Dateiname As String
Dim Antwort As Integer
Dim Wert As String
Dim rngZelle As Range
Dim lngAnz As Long
Dim sh As Worksheet
Dim rng As Range
Application.ScreenUpdating = False
'prüfen ob ein Ordner vorhanden ist und falls nicht
'fragen ob Ordner erstellt werden soll
'Datei Speichern unter angegeben Pfad mit Erstellung des Ordners und Speicherung als Preisliste_SSL_Lieferanten_V0.
Wert = [A2].Value
ord = "P:\gba\abteilungen\AEC\EPLAN\Data\Projekte\KEBA AG\" & Wert & ".edb" & "\DOC" & "\Angebot"
If Dir(ord, vbDirectory) <> "" Then
MsgBox "Ein Ordner mit dem Namen Angebot ist im Verzeichnis " & ord & " schon vorhanden!"
MsgBox "Es wird kein Ordner angelegt das Dokument wird jedoch in den vorhandenen Ordner gespeichert!"
Else
Antwort = MsgBox("Der Ordner " & ord & " ist nicht vorhanden!" _
& vbNewLine _
& "Soll der Ordner angelegt werden?", vbYesNo)
If Antwort = vbYes Then
MkDir ord
MsgBox "Der Ordner " & ord & " wurde angelegt und die Datei darin gespeichert!"
Else
MsgBox "Es wurden keine Änderungen vorgenommen!"
End If
End If
ActiveWorkbook.Sheets.Copy 'Tabellenblatt kopieren
For Each sh In ActiveWorkbook.Worksheets
For Each rng In sh.UsedRange.Cells
rng.Formula = rng.Value 'Formeln, SVerweise, etc. durch Werte ersetzen
Next
Next
ActiveSheet.Shapes.Range(Array("Button 4")).Select 'Makro Buttons löschen
Selection.Delete
ActiveSheet.Shapes.Range(Array("Button 3")).Select 'Makro Buttons löschen
Selection.Delete
ActiveSheet.Shapes.Range(Array("Button 2")).Select 'Makro Buttons löschen
Selection.Delete
ActiveSheet.Shapes.Range(Array("Button 1")).Select 'Makro Buttons löschen
Selection.Delete
'Datei speichern
ActiveWorkbook.SaveCopyAs Filename:="P:\gba\abteilungen\AEC\EPLAN\Data\Projekte\KEBA AG\" & Wert & ".edb" & "\DOC" & "\Angebot\Preisliste_SSL_Lieferanten_V0_EPG.xlsx" _
Application.DisplayAlerts = False 'Meldungen deaktivieren (Meldung ob man das Dokument speichern will)
ActiveWorkbook.Close 'das kopierte Tabellenblatt wieder schließen
Application.DisplayAlerts = True 'Meldungen aktivieren
Application.ScreenUpdating = True
End Sub
|