Import/Export Daten
15.11.2021 14:39:49
Peer
Ich steh wieder mal vor einem Problem.
Ich habe in meinem (großem) Projekt eine Möglichkeit schaffen wollen, die alle Daten in einer UF in eine extern Datei speichern soll und bei Bedarf wieder zurückschreibt.
Dabei habe ich im Web eine Lösung gefunden, die ich auf meine Bedürfnissen anpassen wollte. In der UF sind Steuerelemente jeglicher Art.
Mit meinen Anfänger-VBA-Wissen konnte ich bis jetzt keine Lösung finden.
Der Export scheint zu funktionieren, also keine Fehlermeldung und die externe txt-Datei hat die Daten auch.
Aber beim Import bekomme ich die Fehlermeldung Laufzeitfehler 1004 - NumberFormat ...Range-Objektes ... und der Debugger bleibt bei
If strFile CStr(False) Then
ff = FreeFile
Open strFile For Input As #ff
Do While Not EOF(ff)
Line Input #ff, strTmp
With Range(Split(strTmp, ";")(0))
.Formula = Split(strTmp, ";")(1)
.NumberFormat = Split(strTmp, ";")(2)
End With
Loop
Close #ff
End If
hängen.Ich kann den Fehler nicht erkennen.
Vielleicht kann mir jemand dazu helfen?
Die Bespiel-Datei ist zu groß, um sie hochzuladen. Und wenn ich sie reduziere, funktionieren andere Teile nicht mehr.
Deshalb schicke ich den Code und die exportierte Datei.
Export
Option Explicit
' Modul-Typ: Allgemeines Modul
' von Josef Ehrensberger
Sub exportParameter()
Dim vntFile As Variant
Dim rng As Range, rngC As Range
Dim ff As Integer
On Error Resume Next
Application.ScreenUpdating = False
Sheets("Parameter").Unprotect
Set rngC = Sheets("Parameter").UsedRange.SpecialCells(xlCellTypeConstants)
'oder
'Set rngC = ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)
'oder
'Set rngC = Range("A1:A5,C5:C10,H3:I17")
On Error GoTo 0
If Not rngC Is Nothing Then
vntFile = Application.GetSaveAsFilename("Parameter.txt", "Text Files (*.txt), *.txt")
If vntFile False Then
ff = FreeFile
Open vntFile For Output As #ff
For Each rng In rngC.Cells
Print #ff, rng.Address(0, 0) & ";" & rng.Formula & ";" & rng.NumberFormat
Next
Close #ff
End If
End If
Set rng = Nothing
Set rngC = Nothing
Application.ScreenUpdating = True
Sheets("Parameter").Protect
End Sub
Import
Sub importParameter()
Dim strFile As String, strTmp As String
Dim ff As Integer
strFile = Application.GetOpenFilename("Text Dateien (*.txt),*.txt")
Sheets("Parameter").Unprotect
If strFile CStr(False) Then
ff = FreeFile
Open strFile For Input As #ff
Do While Not EOF(ff)
Line Input #ff, strTmp
With Range(Split(strTmp, ";")(0))
.Formula = Split(strTmp, ";")(1)
.NumberFormat = Split(strTmp, ";")(2)
End With
Loop
Close #ff
End If
Sheets("Parameter").Protect
Unload frm_Parameter
frm_Parameter.Show
End Sub
Vielen Dank im Voraushttps://www.herber.de/bbs/user/149151.txt
Peer