AW: Formatierung beim Ex- und Import beibehalten
22.08.2006 19:26:13
fcs
Hallo Andre,
die Werte WAHR und FALSCH werden beim Importieren von deinen Prozeduren als Text eingelesen/interpretiert.
Mit den nachfolgenden Anpassungen werden in den Zellen Boolsche Werte WAHR und FALSCH eingetragen. Falls in den anderen Textzellen auch der Text "wahr" oder "falsch" stehen kann, dann muss als weiteres Kriterium ggf. die auszufüllende Zelladresse geprüft werden.
gruss
Franz
Sub Importieren_Alles()
Dim objblatt As Object
Dim varPfad As Variant
Dim strText As String
Dim lngZ As Long
Dim strFormat As String
Dim strTabelle As String, strZelle As String, varInhalt As String, strAktBlatt As String
lngZ = 1
varPfad = lblDatei.Caption
strAktBlatt = ActiveSheet.Name
Application.ScreenUpdating = False
Open varPfad For Input As #1
Do While Not EOF(1)
Line Input #1, strText
If lngZ > 1 Then
strTabelle = STRINGG(strText, 1)
For Each objblatt In ActiveWorkbook.Sheets
If objblatt.Name = strTabelle Then GoTo GEFUNDEN
Next
MsgBox "Das Blatt " & strTabelle & " wurde nicht gefunden, der Vorgang wird abgebrochen.", vbOKOnly + vbExclamation, "Fehler"
Application.StatusBar = False
Application.ScreenUpdating = True
Exit Sub
GEFUNDEN:
Application.StatusBar = "Daten werden importiert, Blatt " & strTabelle & ", Zelle " & strZelle & ", Inhalt: " & varInhalt
strZelle = STRINGG(strText, 2)
varInhalt = STRINGG(strText, 3)
Sheets(strTabelle).Select
strFormat = Range(strZelle).NumberFormat
Range(strZelle).NumberFormat = "General"
If Left(varInhalt, 1) = "=" Then
Range(strZelle).Formula = varInhalt
Else
'Anpassung Anfang
Select Case varInhalt
Case "Wahr", "WAHR", "wahr"
Range(strZelle) = True
Case "Falsch", "FALSCH", "falsch"
Range(strZelle) = False
Case Else
Range(strZelle) = varInhalt
End Select
'Anpassung Ende
End If
Range(strZelle).NumberFormat = strFormat
End If
lngZ = lngZ + 1
Loop
Close
Sheets(strAktBlatt).Select
End Sub
Sub Importieren_Spalte_F()
Dim objblatt As Object
Dim varPfad As Variant
Dim strText As String
Dim lngZ As Long
Dim strFormat As String
Dim strTabelle As String, strZelle As String, varInhalt As String, strAktBlatt As String
lngZ = 9
varPfad = lblDatei.Caption
strAktBlatt = ActiveSheet.Name
Application.ScreenUpdating = False
Open varPfad For Input As #1
Do While Not EOF(1)
Line Input #1, strText
If lngZ > 9 Then
Application.StatusBar = "Daten werden importiert, Zeile " & lngZ
strFormat = Sheets("Daten").Cells(lngZ, 6).NumberFormat
Sheets("Daten").Cells(lngZ, 6).NumberFormat = "General"
If Left(strText, 1) = "=" Then
Sheets("Daten").Cells(lngZ, 6).FormulaLocal = strText
Else
'Anpassung Anfang
Select Case strText
Case "Wahr", "WAHR", "wahr"
Sheets("Daten").Cells(lngZ, 6) = True
Case "Falsch", "FALSCH", "falsch"
Sheets("Daten").Cells(lngZ, 6) = False
Case Else
Sheets("Daten").Cells(lngZ, 6) = strText
End Select
'Anpassung Ende
End If
Sheets("Daten").Cells(lngZ, 6).NumberFormat = strFormat
End If
lngZ = lngZ + 1
Loop
Close
Sheets(strAktBlatt).Select
End Sub