Sub
Umwand_schreib()
Dim
Datei_2
As
Variant
Dim
FF
As
Integer
Dim
strZeile
As
String
Dim
lngZeile
As
Long
Dim
ZeileB
As
Long
Dim
blLeer
As
Boolean
Dim
Zeile_write
As
Integer
Dim
Spalte_read
As
Integer
Dim
Spalte_write
As
Integer
Dim
Zeile_l
As
Integer
Dim
WertZelle
As
String
Dim
LängeZelle
As
String
Zeile_write = 55
If
Tabelle1.CheckBox4 =
True
Then
Spalte_read = 6
If
Tabelle1.CheckBox4 =
True
Then
Spalte_write = 6
If
Tabelle1.CheckBox5 =
True
Then
Spalte_read = 7
If
Tabelle1.CheckBox5 =
True
Then
Spalte_write = 7
For
Zeile_l = 4
To
47
WertZelle = Cells(Zeile_l, Spalte_read).Value
LängeZelle = Len(WertZelle)
If
LängeZelle > 0
Then
For
i = 1
To
LängeZelle
Cells(Zeile_write, Spalte_write).Value =
"ChrW("
& AscW(Mid(WertZelle, i, 1)) &
")"
Zeile_write = Zeile_write + 1
Next
Else
Cells(Zeile_write, Spalte_write).Value =
""
"..."
""
MsgBox
"Die Spalte: "
& Spalte_write &
" in Zeile: "
& Zeile_l &
" enthält keinen Wert"
& vbCrLf _
&
"Export nicht komplett!!!"
, vbCritical,
"+++ Warning +++ Warning +++ Warning +++"
Zeile_write = Zeile_write + 1
End
If
Zeile_write = Zeile_write + 1
Next
If
Datei_2 =
False
Then
Exit
Sub
FF = FreeFile()
Open Datei_2
For
Output
As
#FF
ZeileB = 4
strZeile = Cells(ZeileB, 2).text &
" = "
If
Tabelle1.CheckBox4 =
True
Then
Spalte_write = 6
If
Tabelle1.CheckBox5 =
True
Then
Spalte_write = 7
For
lngZeile = 55
To
Cells(Rows.Count, Spalte_write).
End
(xlUp).row
If
IsEmpty(Cells(lngZeile, Spalte_write))
Then
If
blLeer =
True
Then
ZeileB = ZeileB + 1
Print #FF,
" "
& Left(strZeile, Len(strZeile) - 3)
strZeile = Cells(ZeileB, 2).text &
" = "
blLeer =
False
End
If
Else
strZeile = strZeile & Cells(lngZeile, Spalte_write).text &
" & "
blLeer =
True
End
If
Next
Debug.Print IngZeile
Print #FF,
" "
& Left(strZeile, Len(strZeile) - 3)
Print #FF,
"End Sub"
Close #FF
zeigen = Shell(
"C:\Program Files (x86)\Notepad++"
&
"\notepad++.exe "
& Datei_2, 1)
Range(
"F55:G1000"
).
Select
Selection.Clear
Range(
"A1"
).
Select
E