Mein Code läuft bestens bei mir
Reinhard
Hi Roland,
nachfolgender Code, der auch in dieser Datei steckt:
https://www.herber.de/bbs/user/18762.xls
läuft problemlos
Durch Ändern der Zeile
Ausgabegerät = ...
kannst man ändern ob er auf dem Drucker ausgibt oder in die datei schreibt, er funtioniert in beiden Fällen.
Gestarte wird der Code in dem man Tabelle1 auswählt. Automatisch werden dann die bestehenden Werte in der Datei ausgegeben.
Jungfräulich sind das nur die ersten 5 Zeilen wie gewünscht.
Also sieht die Datei drucker.txt (bzw die Ausgabe auf dem Drucker so aus:
1: 1 a g 1 müller
2: 2 b h 2 schmidt
3: 3 c i 3 hans
4: 4 d j 4 fgfg
5: 5 e k 5 dgf
So, jetzt gehe in in Zeile 6 fülle dort spalten 1 bis 3 aus, erst wenn ich Zeile 10 aufsuche wird das ausgegeben, dann besuche ich nacheinenader abwechselne Zeile 12 und 14, ändere da jeweils auch was, usw. usw.
Danach sieht die Ausgabe so aus:
1: 1 a g 1 müller
2: 2 b h 2 schmidt
3: 3 c i 3 hans
4: 4 d j 4 fgfg
5: 5 e k 5 dgf
6: 1 2 3
10: 4
12: 5
14: 6
12: 5 7
14: 6 8
12: 5 7 9
14: 6 8 10
15: 11
17: 12
19: 13
20: 14
während die Tabelle1 so aussieht:
Tabellenblattname: Tabelle1
A | B | C | D | E | F | G | H | I | J |
1| 1 | a | g | 1 | müller | | | | | |
2| 2 | b | h | 2 | schmidt | | | | | |
3| 3 | c | i | 3 | hans | | | | | |
4| 4 | d | j | 4 | fgfg | | | | | |
5| 5 | e | k | 5 | dgf | | | | | |
6| 1 | 2 | 3 | | | | | | | |
7| | | | | | | | | | |
8| | | | | | | | | | |
9| | | | | | | | | | |
10| | | | 4 | | | | | | |
11| | | | | | | | | | |
12| | | | | 5 | | 7 | | 9 | |
13| | | | | | | | | | |
14| | | | | | 6 | | 8 | | 10 |
15| | 11 | | | | | | | | |
16| | | | | | | | | | |
17| | 12 | | | | | | | | |
18| | | | | | | | | | |
19| | 13 | | | | | | | | |
20| | 14 | | | | | | | | |
Getestet an Canon BJC 220, warum es bei dir nicht funktioniert, k.A.
Gruß
Reinhard
Der Code:
in Diese Arbeitsmappe:
Private Sub Workbook_Open()
Worksheets("Tabelle2").Activate
End Sub
in Tabelle1:
Option Base 1
Dim Ber1_5 As Boolean
Dim Dateinummer As Integer
Dim zei As Long
Dim Ausgabegerät As String
Private Sub Worksheet_Activate()
If Ber1_5 = False Then
Dim länge(5) As Integer
Ausgabegerät = "c:\test\drucker.txt"
'Ausgabegerät = "LPT1"
Dateinummer = FreeFile
Open Ausgabegerät For Output As #Dateinummer
sp = Application.WorksheetFunction.Max(länge)
For z = 1 To ActiveSheet.UsedRange.Rows.Count
Print #Dateinummer, z & ": ";
For s = 1 To ActiveSheet.UsedRange.Columns.Count
Print #Dateinummer, Cells(z, s) & " ";
'Print #Dateinummer, Tab((s - 1) * 6 + 1); Cells(z, s);
Next s
Print #Dateinummer, vbLf
Next z
Close #Dateinummer
' For n = 1 To 5
' länge(n) = Cells(n, 256).End(xlToLeft).Column
' 'MsgBox länge(n)
' Next n
' Dateinummer = FreeFile
' Open Ausgabegerät For Output As #Dateinummer
' sp = Application.WorksheetFunction.Max(länge)
' For z = 1 To 5
' Print #Dateinummer, z & ": ";
' For s = 1 To sp
' Print #Dateinummer, Cells(z, s) & " ";
' 'Print #Dateinummer, Tab((s - 1) * 6 + 1); Cells(z, s);
' Next s
' Print #Dateinummer, vbLf
' Next z
' Close #Dateinummer
Application.EnableEvents = False
Range("A6").Select
Application.EnableEvents = True
zei = 6
Range(Cells(zei, 1), Cells(zei, 256)).Copy Destination:=Worksheets("Tabelle3").Range("A1:IV2")
For n = 1 To 256
Worksheets("Tabelle3").Cells(3, n).FormulaR1C1 = "=if(r1c" & n & "=r2c" & n & ",0,1)"
Next n
Application.MoveAfterReturnDirection = xlToRight
Ber1_5 = True
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Range(Cells(zei, 1), Cells(zei, 256)).Copy Destination:=Worksheets("Tabelle3").Range("A2:iv2")
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row = zei Or Target.Row <= 5 Then Exit Sub
If Application.WorksheetFunction.Sum(Worksheets("Tabelle3").Range("A3:IV3")) > 0 Then
Dateinummer = FreeFile
'CON, AUX, COM1, COM2, COM3, COM4, LPT1, LPT2, LPT3, PRN und NUL
If Ausgabegerät = "LPT1" Then
Open Ausgabegerät For Output As #Dateinummer
Else
Open Ausgabegerät For Append As #Dateinummer
End If
Print #Dateinummer, zei & ": ";
sp = Worksheets("Tabelle3").Range("IV2").End(xlToLeft).Column
For s = 1 To sp
Print #Dateinummer, Cells(zei, s) & " ";
Next s
Print #Dateinummer, vbLf
Close #Dateinummer
End If
zei = Target.Row
Range(Cells(zei, 1), Cells(zei, 256)).Copy Destination:=Worksheets("Tabelle3").Range("A1:IV2")
End Sub
Sub reset()
MsgBox Ber1_5
Ber1_5 = False
Close
Application.EnableEvents = True
End Sub