Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1460to1464
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

Pfad in einem Makro ändern

Pfad in einem Makro ändern
28.11.2015 11:35:10
parza

Hallo, dank eurer Hilfe habe ich ein super funktierendes Excel-Macro um alle Dateien in einem beliebigen Ordner mit Blattschutz zu versehen bzw. aufzuheben. Nun meiner Frage: Bisher muss man den Ort, wo das Makro suchen soll, direkt in den code schreiben. Da ich nicht möchte, das die Mitarbeiter direkt ins Makro schreiben, wäre es schön, wenn man dies über einen Mini-Explorerfenster auswählen könnte und dies direkt ins Makro eingetragen wird. D.h. Der Pfad in strParth soll entsprechend angepasst werden.
Danke parza
Das wäre das Makro
Option Explicit

Sub schutzAus()
Dim objWB As Workbook, objSh As Worksheet
Dim strFile As String, strPath As String
On Error GoTo ErrorHandler
Static CalculationMode As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
.AskToUpdateLinks = False
CalculationMode = .Calculation
.Calculation = xlManual
.DisplayAlerts = False
End With
strPath = "E:\Forum" 'Verzeichnis - Anpassen!
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
strFile = Dir(strPath & "*.xls", vbNormal)
Do While strFile <> ""
Set objWB = Workbooks.Open(strPath & strFile)
For Each objSh In objWB.Worksheets
objSh.Unprotect
Next
objWB.Close True
strFile = Dir
Loop
ErrorHandler:
With Err
If .Number <> 0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "'schutzAus'" & vbLf & String(60, "_") & _
vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
.Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
"VBA - Fehler in Prozedur - schutzAus"
.Clear
End If
End With
On Error GoTo 0
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalculationMode
.DisplayAlerts = True
.StatusBar = False
End With
Set objWB = Nothing
Set objSh = Nothing
End Sub

Sub schutzEin()
Dim objWB As Workbook, objSh As Worksheet
Dim strFile As String, strPath As String
On Error GoTo ErrorHandler
Static CalculationMode As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
.AskToUpdateLinks = False
CalculationMode = .Calculation
.Calculation = xlManual
.DisplayAlerts = False
End With
strPath = "E:\Forum" 'Verzeichnis - Anpassen!
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
strFile = Dir(strPath & "*.xls", vbNormal)
Do While strFile <> ""
Set objWB = Workbooks.Open(strPath & strFile)
For Each objSh In objWB.Worksheets
objSh.Protect
Next
objWB.Close True
strFile = Dir
Loop
ErrorHandler:
With Err
If .Number <> 0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "'schutzEin'" & vbLf & String(60, "_") & _
vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
.Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
"VBA - Fehler in Prozedur - schutzEin"
.Clear
End If
End With
On Error GoTo 0
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalculationMode
.DisplayAlerts = True
.StatusBar = False
End With
Set objWB = Nothing
Set objSh = Nothing
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Pfad in einem Makro ändern
28.11.2015 11:56:20
Matthias
Hallo Parza,
das würde so funktionieren:
Dim objShell As Object, objFolder As Object
Const strStartPath As String = "D:\Eigene Dateien" '
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0&, "Ordner wählen", _
&H4000, strStartPath)
If Not objFolder Is Nothing Then
strPath = objFolder.Self.Path
Else
' deine Aktionen wenn Abbrechen gewählt
End If
Dies ersetzt dann deine Zeile "strPath = "E:\Forum" 'Verzeichnis - Anpassen!".
lg Matthias

AW: Pfad in einem Makro ändern
28.11.2015 11:58:01
Hajo_Zi

Function GetAOrdner2() As String
If BoFehler Then On Error GoTo Errorhandler1
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then
GetAOrdner2 = .SelectedItems(1) & "\"
Else
GetAOrdner2 = ""
End If
End With
Exit Function
'Errorhandler1:
'    Fehlerbehandlung 1, 167
End Function
Sub Start()
MsgBox GetAOrdner2
End Sub

Anzeige
AW: Pfad in einem Makro ändern
29.11.2015 09:39:08
parza
Super, vielen Dank.
Ist deine Lösung bei jedem Makro anwendbar, bei denen eine entsprechende Pfadeingabe gewünscht ist?

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige