Makro-Problem
01.03.2006 10:57:24
Martin
ich habe ein kleines Problem. Mir wurde hier im Forum geholfen mit einem Makro, dass es mir ermöglicht während des Speicherns automatisch noch eine Sicherung der Datei in einem anderen Pfad zu hinterlegen.
Mein Problem ist folgendes: Ich möchte dieses Makro nur in einer Datei verwenden, bei der ich es auch in eine Befehlsschaltfläche eingebaut habe. Doch wenn ich nun andere Excel-Dateien ganz normal via Speicher-Symbol speichern möchte, dann werde ich auf die Datei mit dem Speichermakro verwiesen. Das Makro sieht folgendermaßen aus:
Ich hoffe mir kann jemand helfen bei meinem Problem. Ich möchte, dass das Speichermakro sich wirklich nur auf die eine Datei bezieht. Schonmal vielen Dank!
Private Sub CommandButton1_Click()
Dim s_pfad(20)
'Feldvariablen, kann max 20 Werte aufnehmen
SPfad = "D:\Save"
'Zuweisung von festem Laufwerk und Verzeichnis
OPfad = ActiveWorkbook.Path
'Einlesen des Pfades
On Error Resume Next
'wenn Fehler im weiteren Ablauf auftreten, weiter mit der nächsten Anweisung
opfad2 = Right(OPfad, Len(OPfad) - 3)
'ermittelt die Zeichen einer Zeichenkette von rechts. Die Gesamtlänge wird um 3 Zeichen gekürzt
'z.B. aus D:\Test\Save wird Test\Save
spfad2 = SPfad & "\" & opfad2
'Verketten der Variablen
n = 0
For s = 1 To Len(spfad2)
If Mid(spfad2, s, 1) = "\" Then
s_pfad(n) = Left(spfad2, s - 1)
Debug.Print n, s_pfad(n)
n = n + 1
End If
Next s
s_pfad(n) = spfad2
oname = ActiveWorkbook.Name
'Zuordnen des Namens der aktiven Arbeitsmappe
On Error GoTo erstellen
'bei Fehler wird auf "Erstellen" gesprungen
For t = 1 To n
ChDir (s_pfad(t))
'Wechseln zum Verzeichnis, wenn nicht vorhanden
Next t
ActiveWorkbook.SaveCopyAs FileName:=spfad2 & "\" & oname
'Speichern Kopie im neuen Verzeichnis
ActiveWorkbook.Save
'speichern der Mappe im alten Verzeichnis
Exit Sub
erstellen:
MkDir (s_pfad(t))
'Einrichten Verzeichnis
Resume Next
'zurück zum Aufruf
End Sub
Sub sf_ein()
Set SM = CommandBars.FindControl(Id:=3)
SM.OnAction = "Test"
End Sub
Sub sf_aus()
Set SM = CommandBars.FindControl(Id:=3)
SM.OnAction = ""
End Sub