Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1056to1060
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

Excel-Dateien- Werte ersetzen

Excel-Dateien- Werte ersetzen
09.03.2009 12:46:10
Bernd
Hallo zusammen,
ich würde gerne bei mehreren Excel-Dateien, die sich alle im selben Verzeichnis befinden, in einem "Rutsch", sämtliche Formeln durch Werte ersetzen, ohne das ich die Dateien einzeln öffnen muss!
Geht das?
Gruß
Bernd

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Excel-Dateien- Werte ersetzen
09.03.2009 12:57:27
Josef
Hallo Bernd,
' **********************************************************************
' Modul: Modul3 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Festschreiben()
  Dim strPath As String, strFile As String
  Dim objWB As Workbook, objWS As Worksheet
  
  On Error GoTo ErrExit
  GMS
  
  strPath = "E:\Office\Excel\Forum\Test" 'Verzeichnis - Anpassen!
  
  If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
  
  strFile = Dir(strPath & "*.xl*")
  
  Do While strFile <> ""
    
    If strFile <> ThisWorkbook.Name Then
      Set objWB = Workbooks.Open(strPath & strFile, True)
      For Each objWS In objWB.Worksheets
        objWS.UsedRange = objWS.UsedRange.Value
      Next
      objWB.Close True
    End If
    
    strFile = Dir
    
  Loop
  
  ErrExit:
  With Err
    If .Number <> 0 Then MsgBox .Number & vbLf & .Description, vbExclamation, "Fehler"
  End With
  GMS True
  Set objWS = Nothing
  Set objWB = Nothing
End Sub

Public Sub GMS(Optional ByVal Modus As Boolean = False)
  
  Static lngCalc As Long
  
  
  With Application
    .ScreenUpdating = Modus
    .EnableEvents = Modus
    .DisplayAlerts = Modus
    .EnableCancelKey = IIf(Modus, 1, 0)
    If Not Modus Then lngCalc = .Calculation
    If Modus And lngCalc = 0 Then lngCalc = -4105
    .Calculation = IIf(Modus, lngCalc, -4135)
    .Cursor = IIf(Modus, -4143, 2)
    
  End With
  
  
End Sub

Gruß Sepp

Anzeige
AW: Excel-Dateien- Werte ersetzen
09.03.2009 13:18:57
Bernd
Hallo !
Klappt schon mal vorzüglich!
Vielleicht noch folgende "Nice-to have"-Ideen:
1.) Lässt sich die Orderauswahl per Auswahlmaske dynamischer gestalten?
2.) Könnte man an die so modifizierten Dateien im Dateinnamen mit der Ergänzung _Werte.xls speichern?
3.) Könnte man noch eine Bestätigungsmeldung, z. b. "Konvertierung durchgeführt" einbauen?
Viele Grüße und danke schon mal!
Bernd
AW: Excel-Dateien- Werte ersetzen
09.03.2009 13:28:25
Josef
Hallo Bernd,
' **********************************************************************
' Modul: Modul3 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Festschreiben()
  Dim strPath As String, strFile As String, strNewName As String, strExt As String
  Dim objWB As Workbook, objWS As Worksheet
  Dim intCount As Integer
  
  On Error GoTo ErrExit
  GMS
  
  strPath = fncBrowseForFolder
  
  If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
  
  strFile = Dir(strPath & "*.xl*")
  
  Do While strFile <> ""
    
    If strFile <> ThisWorkbook.Name Then
      If Not strFile Like "*_Werte*" Then
        intCount = intCount + 1
        Set objWB = Workbooks.Open(strPath & strFile, True)
        For Each objWS In objWB.Worksheets
          objWS.UsedRange = objWS.UsedRange.Value
        Next
        strNewName = Left(strFile, InStrRev(strFile, ".")) & "_Werte"
        strExt = Mid(strFile, InStrRev(strFile, "."))
        objWB.SaveAs strPath & strNewName & strExt
        objWB.Close True
      End If
    End If
    
    strFile = Dir
    
  Loop
  
  If intCount > 0 Then
    MsgBox "Es wurden " & CStr(intCount) & " Dateien konvertiert!"
  Else
    MsgBox "Es wurden keine Dateien konvertiert!"
  End If
  ErrExit:
  With Err
    If .Number <> 0 Then MsgBox .Number & vbLf & .Description, vbExclamation, "Fehler"
  End With
  GMS True
  Set objWS = Nothing
  Set objWB = Nothing
End Sub

Public Sub GMS(Optional ByVal Modus As Boolean = False)
  
  Static lngCalc As Long
  
  
  With Application
    .ScreenUpdating = Modus
    .EnableEvents = Modus
    .DisplayAlerts = Modus
    .EnableCancelKey = IIf(Modus, 1, 0)
    If Not Modus Then lngCalc = .Calculation
    If Modus And lngCalc = 0 Then lngCalc = -4105
    .Calculation = IIf(Modus, lngCalc, -4135)
    .Cursor = IIf(Modus, -4143, 2)
    
  End With
  
  
End Sub


Private Function fncBrowseForFolder(Optional ByVal defaultPath = "") As String
  Dim objFlderItem As Object, objShell As Object, objFlder As Object
  
  Set objShell = CreateObject("Shell.Application")
  Set objFlder = objShell.BrowseForFolder(0&, "Ordner auswählen...", 0&, defaultPath)
  
  If objFlder Is Nothing Then GoTo ErrExit
  
  Set objFlderItem = objFlder.Self
  fncBrowseForFolder = objFlderItem.Path
  
  ErrExit:
  
  Set objShell = Nothing
  Set objFlder = Nothing
  Set objFlderItem = Nothing
End Function

Gruß Sepp

Anzeige
AW: Excel-Dateien- Werte ersetzen
09.03.2009 14:38:47
Bernd
Hallo Sepp,
toll, auch dies funktioniert nun wie gewünscht! Damit ich das Makro noch universeller und vor allem losgetrennt von meinen Originaldateien mit zahlreichen Formeln verwenden kann, wäre vielleicht folgendes noch sinnvoll:
1.) Ich würde gerne den zu konvertierenden Ordner per Auswahlmaske auswählen (wie bereits von Dir schon programmiert), in einem 2. Schritt sollen aber nur bestimmte Dateien aus diesem Ordner relevant sein: Diese sollten entweder über den Explorer auswählbar sein, oder aber folgender Syntax folgen: Dateiname muss auf V*.xls lauten oder C*.xls. Diese Vorgabe kann gerne auch fest im Code "verankert" sein, da sich das nicht ständig ändert.
2.) Lässt sich ein spezielles Ausgabeverzeichnis für die konvertierten Dateien benutzen, um Originaldateien und konvertierte Werte-Datein eindeutig voneinander zu trennen? Das Ausgabeverzeichnis kann schon vorher angelegt sein (z. B: C:\Ausgabeverzeichnis), sollte aber ebenfalls flexibel über Maske auswählbar sein!
Ich hoffe, Ich habe Dich wegen dieer "Zusatzanforderungen" nicht übermassen in Anspruch genommen, aber Deine 1. Lösung hat bereits Appetit auf mehr gemacht :-)
Viele Grüße
Bernd
Anzeige
AW: Excel-Dateien- Werte ersetzen
09.03.2009 23:01:38
Josef
Hallo Bernd,
war am Nachmittag nicht zu Hause, deshalb kam ich erst jetzt dazu.
https://www.herber.de/bbs/user/60144.xla
Ich habe das ganze in ein AddIn gepackt, so steht es dir in jeder Datei zur Verfügung.
Speichere die Datei in einem beliebigen Verzeichnis, gehe in Excel auf > Extras > AddIns > Durchsuchen > und wähle die gespeicherte Datei aus, XLFileConverter im AddIn-Dialog anhaken und du findest in der Worksheet-Menüleiste einen neuen Menüpunkt. Viel Spass!
PS: Das Kennwort für das VBA-Projekt = x
Gruß Sepp

Anzeige
Super, Danke!
10.03.2009 07:45:21
Bernd
Hallo Sepp,
besten Dank! Ich konnte das Makro ja schom vorher gut einsetzen, nun dürfte es perfekt sein (als Addin).
Ich kann es leider erst am Mittwoch testen, aber ich bin jetzt schon sicher, das funktionieren wird! Ansonsten öffne ich nochmal den Thread!
Ich werde zu einer ähnlichen Sache (Auswahl von Excel-Dateien aus einem Verzeichnis) einen neuen Thread aufmachen. Wäre schön, wenn Du bei Gelegenheit kurz reinschauen könntest:-)
Vielen Dank schon mal für die Mühe!
Viele Grüße
Bernd
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige