|
Ein problem habe ich dann doch noch:
er soll im case 4 diese Funktion aufrufen und ausführen:
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
|