Anzeige
Archiv - Navigation
1328to1332
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

Dokument aktualisieren mit VBA

Dokument aktualisieren mit VBA
20.09.2013 08:26:59
Grziwa
Hallo liebe VBA-Profis,
um eine Übersicht in mehreren Excel Dateien die mit Links gefüllt ist immer aktuell zu halten habe ich mir mit einer Kollegin ein kleines VBA File zusammen geschrieben, das mit der Musterdatei abgeglichen werden soll. Momentan muss man aber die einzelnen Dateien auswählen die aktualisiert werden sollen. Dies soll nun automatisch passieren. Entweder durch hinzufügen der einzelnen Dateien im Code oder mit Angabe eines Ordners, was natürlich eleganter wäre. Nach langen rumprobieren ist es uns leider nicht gelungen. Könnte uns jemand bei dieser Problematik helfen? Anbei der Quellcode
Public Function GetFileNameFromPath(ByVal s As String) As String
s = Replace(s, ":", "/") ' aus allen Doppelpunkten wird ein Slash (Mac OS X Support)
GetFileNameFromPath = Mid$(s, InStrRev(s, "/") + 1)
End Function

Sub CopyRegisterUebersichtToAnotherFile()
Dim file As String
Dim path As String
Dim iam As String
path = GetFilenameFromDialog()
file = GetFileNameFromPath(path)
iam = ActiveWorkbook.Name
If Len(file) Then
Dim book As Excel.Workbook
Set book = Application.Workbooks.Open(path)
If book.Sheets("Übersicht").Name = "Übersicht" Then
Sheets("Übersicht").Name = "ÜbersichtBkp"
Windows(iam).Activate
Sheets("Übersicht").Copy Before:=book.Sheets("ÜbersichtBkp")
Sheets("ÜbersichtBkp").Delete
book.Close savechanges:=True
End If
End If
End Sub
Function GetFilenameFromDialog() As String
Dim sFilter As String, sCaption As String, sFile As String,
sFilter = "XLSM Dateien (*.xlsm),*.xlsm"
sCaption = "Please Select a File " & TheUser
sFile = Application.GetOpenFilename()
If sFile "False" Then
GetFilenameFromDialog = sFile
Else
GetFilenameFromDialog = ""
End If
End Function

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Dokument aktualisieren mit VBA
20.09.2013 09:50:23
fcs
Hallo Grziwa,
folgende Version des Makros funktioniert unter Windows, Excel 2010.
Alle XLSM-Dateien des gewählten Ordners werden in einer Schleife abgearbeitet.
Ob auch unter Mac OS kann ich nicht sagen. Wahrscheinlich muss man die Dir-Anweisung anpassen (siehe VBA-Hilfe zu Dir)
Gruß
Franz

Sub CopyRegisterUebersichtToAnotherFile()
Dim strFile As String
Dim strPath As String
Dim wkbAktiv As Workbook, wksUebNeu As Worksheet
Dim wkbZiel As Excel.Workbook, wksZiel As Worksheet
Set wkbAktiv = ActiveWorkbook
Set wksUebNeu = wkbAktiv.Sheets("Übersicht")
'Auswahl des Ordners/Verzeichnisses mit den zu aktualisierenden Dateien
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Bitte Ordner mit den zu aktualisierenden Dateien auswählen"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show = -1 Then
strPath = .SelectedItems(1)
Else
GoTo Beenden
End If
End With
'Exceldateien mit Makros abarbeiten
strFile = Dir(strPath & Application.PathSeparator & "*.xlsm", vbNormal)
Do Until strFile = ""
Set wkbZiel = Application.Workbooks.Open(strPath & Application.PathSeparator & strFile)
'Prüfen, ob Blatt Übersicht in geöffneter Datei vorhanden
If fncCheckSheet("Übersicht", wkbZiel) = True Then
'Blatt "Übersicht" vorhanden
Set wksZiel = wkbZiel.Sheets("Übersicht")
wksZiel.Name = "ÜbersichtBkp"
wksUebNeu.Copy Before:=wksZiel
Application.DisplayAlerts = False
wksZiel.Delete
Application.DisplayAlerts = True
wkbZiel.Close savechanges:=True
Else
'Blatt "Übersicht" nicht vorhanden
wkbZiel.Close savechanges:=False
End If
Set wkbZiel = Nothing
Set wksZiel = Nothing
strFile = Dir
Loop
Beenden:
Set wkbAktiv = Nothing: Set wksUebNeu = Nothing
End Sub
Function fncCheckSheet(strSheetName, Optional wkb As Workbook) As Boolean
'Prüft ob Blattname in Arbeitsmappe vorhanden
Dim objSheet As Object
On Error GoTo Fehler
If wkb Is Nothing Then Set wkb = ActiveWorkbook
Set objSheet = wkb.Sheets(strSheetName)
fncCheckSheet = True
Exit Function
Fehler:
End Function

Anzeige
AW: Dokument aktualisieren mit VBA
23.09.2013 09:06:45
Grziwa
vielen Dank, funktioniert einwandfrei =)

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige