AW: Schaltfläche auf Zelle beziehen
12.05.2022 11:35:15
Thomas
Hallo Rudi,
danke für die schnelle Rückmeldung.
Leider habe ich schon ein Makro auf der Schaltfläche.
Kannst du mir helfen, das Makro anzupassen?
Ich habe Fett markiert, wo in dem Makro meine Schaltfläche angesprochen wird:
Sub Status_erledigt()
Dim sZielPfadUndOrdner$, Wkb As Workbook, sQuellOrdner$
On Error GoTo ende
'* Name der Schaltfläche
sSF_Name = ActiveSheet.Shapes(Application.Caller).Name
'* Sicherheitsabfrage
sFrage = MsgBox("Ist die """ & Mid(sSF_Name, 4, 25) & """ wirklich erledigt?", vbYesNo + vbQuestion, "?")
If sFrage = vbNo Then GoTo ende
'* ZielOrdner bestimmen
If sSF_Name = "SF_Versandbereit" Then sZielOrdner = "2 Versandbereit\"
If sSF_Name = "SF_Versendet" Then sZielOrdner = "3.2 BL Versand\"
If sSF_Name = "SF_Versendet" And [Cell_Empfaenger] = "US" Then sZielOrdner = "3.1 ISF\"
If sSF_Name = "ISF-Erledigt'" Then sZielOrdner = "3.2 BL Versand\"
If sSF_Name = "SF_Abgeschlossen" Then
With Sheets("A 1")
If .[L1] = "" Then
sZielOrdner = "4 Abgeschlossen\" & .[C8] & "_" & .[D3] & "_" & .[C7] & "\"
Else
sZielOrdner = "4 Abgeschlossen\" & .[C8] & "_" & .[D3] & "_" & .[C7] & "_" & .[L1] & "\"
End If
End With
End If
'* Prüfung, ob der sZielOrdner vorhanden
If Dir(sPfadErledigt & sZielOrdner, vbDirectory) = "" Then MkDir sPfadErledigt & sZielOrdner
'* der Name der aktuellen Datei wird in der Variablen gesichert
Set Wkb = ThisWorkbook
'* Ausgangsordner festhalten
sQuellOrdner = ThisWorkbook.Path & "\"
'* damit wird eine namensgleich vorhandene Datei ohne Nachfrage überschrieben!
Application.DisplayAlerts = False
'* die geöffnete Datei wird unter neuem Namen in den nächsten Ordner kopiert!
sZielPfadUndOrdner = sPfadErledigt & sZielOrdner & Wkb.Name
ActiveWorkbook.SaveAs Filename:=sZielPfadUndOrdner, FileFormat:=xlOpenXMLWorkbookMacroEnabled
'* die soeben gespeicherte Datei wird im vorherigen Ordner gelöscht
If Dir(sQuellOrdner & Wkb.Name) "" Then Kill sQuellOrdner & Wkb.Name
'* Schaltfläche grün färben
Call SchaltflaecheGrün
ende:
End Sub
Vielen Dank vorab.
Gruß Thomas