Excel stürzt ab
10.03.2011 19:38:28
kirsche
Hallo Luc,
ich glaube nicht, dass das Posten des Makros etwas bringt, denn es funktioniert auf insgesamt 3 Rechnern und auf dem 4. eben nur manchmal.
Ich habe heute auch nochmal alle Verweise und Add Ins geprüft und angepasst.
Komischer Weise funktionierte heute die Datei auch auf dem 4. Rechner, wo es gestern die Probleme gab.
Die Probleme tauchen auf den anderen 3 Rechnern nicht auf.
So sieht das erste Makro aus:
Private Sub CommandButton1_Click() 'daten übertragen von tagesretoure
If TextBox11.Value = 1 Or _
TextBox11.Value = 11 Or _
TextBox11.Value = 12 Or _
TextBox11.Value = 13 Then
If IsNumeric(TextBox10) Then
ActiveSheet.Unprotect 'Blattschutz aus
Range("A2").Value = ""
Range("A3").Value = ""
Range("A4").Value = TextBox10.Value
Calculate
Call tages_Fax_Vordruck_erstellen
ActiveSheet.PageSetup.PrintArea = "A1:I" & Range("A65536").End(xlUp).Row
ActiveSheet.Unprotect
Range("A5").End(xlDown).Select
Exit Sub
End If
End If
MsgBox "Dieser Lieferant ist nicht für die tägliche Retoure vorgesehen!"
With TextBox10
.SetFocus
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub
und dann geht es so weiter:
Public Sub tages_Fax_Vordruck_erstellen()
Dim lLetzte As Long ' letzte belegte Zeile Fax-Vordruck gemäß Spalte A
Dim lZeile As Long ' For/Next Zeilen-Index Fax-Vordruck
Dim lIndex As Long ' For/Next Index zum Type-Array
Dim ArtTab() As TabDaten ' der Type-Array
Dim rZelle As Range ' der Range zum Suchen in den Stammdaten
Dim lLetzte_E As Long ' die letzte Zeile in der Eingabe
Dim lZeile_E As Long ' die gefundene Zeile in der Eingabe
Dim lZeile_S As Long ' die gefundene Zeile in den Stammdaten
Dim sStckKto As Single ' der Inhalt aus Stück/Karton - zum Rechnen
Dim WkSh_E As Worksheet ' das Tabellenblatt "Eingabe"
Dim WkSh_S As Worksheet ' das Tabellenblatt "Stammdaten"
Dim WkSh_L As Worksheet ' das Tabellenblatt "Lieferanten"
ActiveSheet.Unprotect 'Blattschutz aus
' kein Bildschirm-Update während der Verarbeitung zulassen
Application.ScreenUpdating = False
Set WkSh_E = Worksheets("Eingabe")
Set WkSh_S = Worksheets("Stammdaten")
Set WkSh_L = Worksheets("Lieferantenstamm")
' mit dem Tabellenblatt "Fax-Vordruck" arbeiten
With Worksheets("Fax-Vordruck")
' die letzte belegte Zeile im Blatt "Fax-Vordruck" gemäß Spalte A
lLetzte = IIf(.Range("A65536") "", 65536, .Range("A65536").End(xlUp).Row)
' evtl. bereits vorhandene Summenzeilen löschen
For lZeile = lLetzte To 7 Step -1
If .Range("A" & lZeile).Value = "Retoure - Gesamtbeleg" Then
.Rows(lZeile & ":" & lLetzte).Delete Shift:=xlUp
Exit For
End If
Next lZeile
' vorhandene Werte (Einzelauflistung) löschen
.Range("A7:J" & lLetzte).ClearContents
' die letzte belegte Zeile im Blatt "Eingabe" gemäß Spalte A
lLetzte_E = IIf(WkSh_E.Range("A65536") "", 65536, _
WkSh_E.Range("A65536").End(xlUp).Row)
' die passenden Einzelauflistungen aus der Eingabe holen
lZeile = 7
For lZeile_E = 4 To lLetzte_E
If Menue.Label5.Caption "" Then
If Trim(Menue.Label5.Caption) = Trim(WkSh_E.Range("T" & lZeile_E).Value) Then 'hole _
lieferantennummer
.Range("A" & lZeile).Value = Trim(WkSh_E.Range("E" & lZeile_E).Value) ' _
artikelnummer
.Range("B" & lZeile).Value = Trim(WkSh_E.Range("F" & lZeile_E).Value) ' _
Artikelbezeichnung
.Range("C" & lZeile).Value = Trim(WkSh_E.Range("G" & lZeile_E).Value) 'menge
.Range("D" & lZeile).Value = Trim(WkSh_E.Range("H" & lZeile_E).Value) 'einheit
.Range("E" & lZeile).Value = Trim(WkSh_E.Range("M" & lZeile_E).Value) 'grund
.Range("F" & lZeile).Value = Trim(WkSh_E.Range("N" & lZeile_E).Value) 'info
.Range("G" & lZeile).Value = Trim(WkSh_E.Range("J" & lZeile_E).Value) 'identnummer
.Range("H" & lZeile).Value = Trim(WkSh_E.Range("K" & lZeile_E).Value) 'liefertag _
lieferant
.Range("I" & lZeile).Value = Trim(WkSh_E.Range("D" & lZeile_E).Value) 'markt
.Range("J" & lZeile).Value = Trim(WkSh_E.Range("R" & lZeile_E).Value) 'lieferant
'Rahmen ziehen
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeLeft).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeLeft).Weight = xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeTop).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeTop).Weight = xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeBottom).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeBottom).Weight = _
xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeRight).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeRight).Weight = xlHairline
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).LineStyle = _
xlContinuous
.Range("D" & lZeile & ":I" & lZeile).Borders(xlInsideVertical).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).Weight = _
xlHairline
.Range("D" & lZeile & ":I" & lZeile).Borders(xlInsideVertical).Weight = _
xlHairline
.Range("A" & lZeile & ":D" & lZeile).WrapText = False
.Range("E" & lZeile & ":Y" & lZeile).WrapText = True
Range("A" & lZeile & ":I" & lZeile).Font.Name = "Arial"
Range("A" & lZeile & ":I" & lZeile).Font.Size = 8
lZeile = lZeile + 1
End If
End If
Next lZeile_E
For lZeile_E = 4 To lLetzte_E
If Menue.Label8.Caption "" Then
If Trim(Menue.Label8.Caption) = Trim(WkSh_E.Range("T" & lZeile_E).Value) Then 'hole _
lieferantennummer
.Range("A" & lZeile).Value = Trim(WkSh_E.Range("E" & lZeile_E).Value) ' _
artikelnummer
.Range("B" & lZeile).Value = Trim(WkSh_E.Range("F" & lZeile_E).Value) ' _
Artikelbezeichnung
.Range("C" & lZeile).Value = Trim(WkSh_E.Range("G" & lZeile_E).Value) 'menge
.Range("D" & lZeile).Value = Trim(WkSh_E.Range("H" & lZeile_E).Value) 'einheit
.Range("E" & lZeile).Value = Trim(WkSh_E.Range("M" & lZeile_E).Value) 'grund
.Range("F" & lZeile).Value = Trim(WkSh_E.Range("N" & lZeile_E).Value) 'info
.Range("G" & lZeile).Value = Trim(WkSh_E.Range("J" & lZeile_E).Value) 'identnummer
.Range("H" & lZeile).Value = Trim(WkSh_E.Range("K" & lZeile_E).Value) 'liefertag _
lieferant
.Range("I" & lZeile).Value = Trim(WkSh_E.Range("D" & lZeile_E).Value) 'markt
.Range("J" & lZeile).Value = Trim(WkSh_E.Range("R" & lZeile_E).Value) 'lieferant
'Rahmen ziehen
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeLeft).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeLeft).Weight = xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeTop).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeTop).Weight = xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeBottom).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeBottom).Weight = _
xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeRight).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeRight).Weight = xlHairline
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).LineStyle = _
xlContinuous
.Range("D" & lZeile & ":I" & lZeile).Borders(xlInsideVertical).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).Weight = _
xlHairline
.Range("D" & lZeile & ":I" & lZeile).Borders(xlInsideVertical).Weight = _
xlHairline
.Range("A" & lZeile & ":D" & lZeile).WrapText = False
.Range("E" & lZeile & ":Y" & lZeile).WrapText = True
Range("A" & lZeile & ":I" & lZeile).Font.Name = "Arial"
Range("A" & lZeile & ":I" & lZeile).Font.Size = 8
lZeile = lZeile + 1
End If
End If
Next lZeile_E
For lZeile_E = 4 To lLetzte_E
If Menue.Label9.Caption "" Then
If Trim(Menue.Label9.Caption) = Trim(WkSh_E.Range("T" & lZeile_E).Value) Then 'hole _
lieferantennummer
.Range("A" & lZeile).Value = Trim(WkSh_E.Range("E" & lZeile_E).Value) ' _
artikelnummer
.Range("B" & lZeile).Value = Trim(WkSh_E.Range("F" & lZeile_E).Value) ' _
Artikelbezeichnung
.Range("C" & lZeile).Value = Trim(WkSh_E.Range("G" & lZeile_E).Value) 'menge
.Range("D" & lZeile).Value = Trim(WkSh_E.Range("H" & lZeile_E).Value) 'einheit
.Range("E" & lZeile).Value = Trim(WkSh_E.Range("M" & lZeile_E).Value) 'grund
.Range("F" & lZeile).Value = Trim(WkSh_E.Range("N" & lZeile_E).Value) 'info
.Range("G" & lZeile).Value = Trim(WkSh_E.Range("J" & lZeile_E).Value) 'identnummer
.Range("H" & lZeile).Value = Trim(WkSh_E.Range("K" & lZeile_E).Value) 'liefertag _
lieferant
.Range("I" & lZeile).Value = Trim(WkSh_E.Range("D" & lZeile_E).Value) 'markt
.Range("J" & lZeile).Value = Trim(WkSh_E.Range("R" & lZeile_E).Value) 'lieferant
'Rahmen ziehen
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeLeft).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeLeft).Weight = xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeTop).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeTop).Weight = xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeBottom).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeBottom).Weight = _
xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeRight).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeRight).Weight = xlHairline
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).LineStyle = _
xlContinuous
.Range("D" & lZeile & ":I" & lZeile).Borders(xlInsideVertical).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).Weight = _
xlHairline
.Range("D" & lZeile & ":I" & lZeile).Borders(xlInsideVertical).Weight = _
xlHairline
.Range("A" & lZeile & ":D" & lZeile).WrapText = False
.Range("E" & lZeile & ":Y" & lZeile).WrapText = True
Range("A" & lZeile & ":I" & lZeile).Font.Name = "Arial"
Range("A" & lZeile & ":I" & lZeile).Font.Size = 8
lZeile = lZeile + 1
End If
End If
Next lZeile_E
For lZeile_E = 4 To lLetzte_E
If Menue.Label10.Caption "" Then
If Trim(Menue.Label10.Caption) = Trim(WkSh_E.Range("T" & lZeile_E).Value) Then 'hole _
lieferantennummer
.Range("A" & lZeile).Value = Trim(WkSh_E.Range("E" & lZeile_E).Value) ' _
artikelnummer
.Range("B" & lZeile).Value = Trim(WkSh_E.Range("F" & lZeile_E).Value) ' _
Artikelbezeichnung
.Range("C" & lZeile).Value = Trim(WkSh_E.Range("G" & lZeile_E).Value) 'menge
.Range("D" & lZeile).Value = Trim(WkSh_E.Range("H" & lZeile_E).Value) 'einheit
.Range("E" & lZeile).Value = Trim(WkSh_E.Range("M" & lZeile_E).Value) 'grund
.Range("F" & lZeile).Value = Trim(WkSh_E.Range("N" & lZeile_E).Value) 'info
.Range("G" & lZeile).Value = Trim(WkSh_E.Range("J" & lZeile_E).Value) 'identnummer
.Range("H" & lZeile).Value = Trim(WkSh_E.Range("K" & lZeile_E).Value) 'liefertag _
lieferant
.Range("I" & lZeile).Value = Trim(WkSh_E.Range("D" & lZeile_E).Value) 'markt
.Range("J" & lZeile).Value = Trim(WkSh_E.Range("R" & lZeile_E).Value) 'lieferant
'Rahmen ziehen
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeLeft).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeLeft).Weight = xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeTop).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeTop).Weight = xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeBottom).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeBottom).Weight = _
xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeRight).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeRight).Weight = xlHairline
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).LineStyle = _
xlContinuous
.Range("D" & lZeile & ":I" & lZeile).Borders(xlInsideVertical).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).Weight = _
xlHairline
.Range("D" & lZeile & ":I" & lZeile).Borders(xlInsideVertical).Weight = _
xlHairline
.Range("A" & lZeile & ":D" & lZeile).WrapText = False
.Range("E" & lZeile & ":Y" & lZeile).WrapText = True
Range("A" & lZeile & ":I" & lZeile).Font.Name = "Arial"
Range("A" & lZeile & ":I" & lZeile).Font.Size = 8
lZeile = lZeile + 1
End If
End If
Next lZeile_E
For lZeile_E = 4 To lLetzte_E
If Menue.Label11.Caption "" Then
If Trim(Menue.Label11.Caption) = Trim(WkSh_E.Range("T" & lZeile_E).Value) Then 'hole _
lieferantennummer
.Range("A" & lZeile).Value = Trim(WkSh_E.Range("E" & lZeile_E).Value) ' _
artikelnummer
.Range("B" & lZeile).Value = Trim(WkSh_E.Range("F" & lZeile_E).Value) ' _
Artikelbezeichnung
.Range("C" & lZeile).Value = Trim(WkSh_E.Range("G" & lZeile_E).Value) 'menge
.Range("D" & lZeile).Value = Trim(WkSh_E.Range("H" & lZeile_E).Value) 'einheit
.Range("E" & lZeile).Value = Trim(WkSh_E.Range("M" & lZeile_E).Value) 'grund
.Range("F" & lZeile).Value = Trim(WkSh_E.Range("N" & lZeile_E).Value) 'info
.Range("G" & lZeile).Value = Trim(WkSh_E.Range("J" & lZeile_E).Value) 'identnummer
.Range("H" & lZeile).Value = Trim(WkSh_E.Range("K" & lZeile_E).Value) 'liefertag _
lieferant
.Range("I" & lZeile).Value = Trim(WkSh_E.Range("D" & lZeile_E).Value) 'markt
.Range("J" & lZeile).Value = Trim(WkSh_E.Range("R" & lZeile_E).Value) 'lieferant
'Rahmen ziehen
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeLeft).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeLeft).Weight = xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeTop).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeTop).Weight = xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeBottom).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeBottom).Weight = _
xlHairline
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeRight).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":I" & lZeile).Borders(xlEdgeRight).Weight = xlHairline
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).LineStyle = _
xlContinuous
.Range("D" & lZeile & ":I" & lZeile).Borders(xlInsideVertical).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).Weight = _
xlHairline
.Range("D" & lZeile & ":I" & lZeile).Borders(xlInsideVertical).Weight = _
xlHairline
.Range("A" & lZeile & ":D" & lZeile).WrapText = False
.Range("E" & lZeile & ":Y" & lZeile).WrapText = True
Range("A" & lZeile & ":I" & lZeile).Font.Name = "Arial"
Range("A" & lZeile & ":I" & lZeile).Font.Size = 8
lZeile = lZeile + 1
End If
End If
Next lZeile_E
' die letzte belegte Zeile im Blatt "Fax-Vordruck" gemäß Spalte A
lLetzte = IIf(.Range("A65536") "", 65536, .Range("A65536").End(xlUp).Row)
' sortieren der Artikel-Nummer, um sie später aufsteigend zu haben
Range("A7:J" & lLetzte).Sort _
Key1:=Range("A7"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
ReDim ArtTab(1 To lLetzte) ' ArtTab auf maximale Größe bringen
ArtTab(1).sArtikel = .Range("A7").Value ' 1. Artikel-Nummer speichern
ArtTab(1).sBezeich = .Range("B7").Value ' 1. Bezeichnung speichern
ArtTab(1).dMenge = CDbl(.Range("C7").Value) ' 1. Menge speichern
For lZeile = 8 To lLetzte ' ab 8, weil Zeile 7 schon im Type-Array gespeichert ist
For lIndex = 1 To lLetzte
If ArtTab(lIndex).sArtikel = .Range("A" & lZeile).Value Then
ArtTab(lIndex).dMenge = ArtTab(lIndex).dMenge + _
CDbl(.Range("C" & lZeile).Value)
Exit For
ElseIf ArtTab(lIndex).sArtikel = "" Then ' 2. bis n-te Daten an Array
ArtTab(lIndex).sArtikel = .Range("A" & lZeile).Value
ArtTab(lIndex).sBezeich = Trim(.Range("B" & lZeile).Value)
ArtTab(lIndex).dMenge = CDbl(.Range("C" & lZeile).Value)
Exit For
End If
Next lIndex
Next lZeile
lZeile = lLetzte + 1 ' die letzte belegte Zeile + 1 ist Start-Zeile der Summen
'formatierungen
With .Range("A" & lZeile)
.Font.Size = 16
.Font.Bold = True
.Font.Underline = xlUnderlineStyleSingle
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.RowHeight = 20
End With
With .Range("I" & lZeile)
.Font.Size = 12
.Font.Bold = True
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
End With
With .Range("A" & lZeile + 1)
.Font.Size = 8
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
With .Range("E" & lZeile + 1 & ":F" & lZeile + 1)
.Font.Size = 10
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.RowHeight = 18
End With
.Range("A" & lZeile).Value = "Retoure - Gesamtbeleg"
'.Range("I" & lZeile).Value = ""
lZeile = lZeile + 1
.Range("A" & lZeile).Value = "FZ Art.Nr."
.Range("B" & lZeile).Value = "Artikelbezeichnung"
.Range("C" & lZeile).Value = "KT-Einheit"
'.Range("D" & lZeile).Value = "heit"
.Range("E" & lZeile).Value = "Gesamt-Menge"
.Range("F" & lZeile).Value = "Lief.Art.Nr."
'Rahmen ziehen
.Range("A" & lZeile & ":F" & lZeile).Borders(xlEdgeLeft).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":F" & lZeile).Borders(xlEdgeLeft).Weight = xlHairline
.Range("A" & lZeile & ":F" & lZeile).Borders(xlEdgeTop).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":F" & lZeile).Borders(xlEdgeTop).Weight = xlHairline
.Range("A" & lZeile & ":F" & lZeile).Borders(xlEdgeBottom).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":F" & lZeile).Borders(xlEdgeBottom).Weight = _
xlHairline
.Range("A" & lZeile & ":F" & lZeile).Borders(xlEdgeRight).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":F" & lZeile).Borders(xlEdgeRight).Weight = xlHairline
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).LineStyle = _
xlContinuous
.Range("D" & lZeile & ":F" & lZeile).Borders(xlInsideVertical).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).Weight = _
xlHairline
.Range("D" & lZeile & ":F" & lZeile).Borders(xlInsideVertical).Weight = _
xlHairline
.Range("A" & lZeile & ":D" & lZeile).WrapText = False
.Range("E" & lZeile & ":Y" & lZeile).WrapText = True
Range("A" & lZeile & ":I" & lZeile).Font.Name = "Arial"
Range("A" & lZeile & ":I" & lZeile).Font.Size = 8
For lIndex = 1 To UBound(ArtTab)
If ArtTab(lIndex).sArtikel = "" Then Exit For
lZeile = lZeile + 1
.Range("A" & lZeile).Value = ArtTab(lIndex).sArtikel
.Range("B" & lZeile).Value = ArtTab(lIndex).sBezeich
Set rZelle = WkSh_S.Range("A:A").Find(ArtTab(lIndex).sArtikel, _
Lookat:=xlWhole, LookIn:=xlValues)
If Not rZelle Is Nothing Then
lZeile_S = rZelle.Row
If Trim(WkSh_S.Range("J" & lZeile_S).Value) "KG" Then 'geändert von K auf J
If Trim(WkSh_S.Range("F" & lZeile_S).Value) = 50 Then
If Trim(WkSh_S.Range("J" & lZeile_S).Value) = "ST" Or _
Trim(WkSh_S.Range("J" & lZeile_S).Value) = "GL" Then
.Range("C" & lZeile).Value = _
CSng(WkSh_S.Range("V" & lZeile_S).Value) & " " & _
Trim(WkSh_S.Range("J" & lZeile_S).Value) & "/" & _
Trim(WkSh_S.Range("K" & lZeile_S).Value) 'K bleibt
sStckKto = CSng(WkSh_S.Range("V" & lZeile_S).Value)
Else
sStckKto = 0
End If
End If
If Trim(WkSh_S.Range("J" & lZeile_S).Value) "KG" Then 'geändert von K auf J
.Range("C" & lZeile).Value = _
Trim(WkSh_S.Range("C" & lZeile_S).Value)
sStckKto = 9999
Else
sStckKto = 0
End If
Else
sStckKto = 0
End If
' .Range("D" & lZeile).Value = Trim(WkSh_S.Range("K" & lZeile_S).Value)
.Range("F" & lZeile).Value = Trim(WkSh_S.Range("Q" & lZeile_S).Value)
.Range("I" & lZeile).Value = "Gesamtsumme"
End If
If sStckKto = 0 Then
.Range("E" & lZeile).Value = Format(CDbl(ArtTab(lIndex).dMenge), "0.000"" KG""")
Else
.Range("E" & lZeile).Value = Format(CDbl(ArtTab(lIndex).dMenge), "0"" Stück""")
' .Range("E" & lZeile).Value = Format(CDbl(ArtTab(lIndex).dMenge) / sStckKto, _
' "0.000"" Karton""")
End If
'Rahmen ziehen
.Range("A" & lZeile & ":H" & lZeile).Borders(xlEdgeLeft).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":H" & lZeile).Borders(xlEdgeLeft).Weight = xlHairline
.Range("A" & lZeile & ":H" & lZeile).Borders(xlEdgeTop).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":H" & lZeile).Borders(xlEdgeTop).Weight = xlHairline
.Range("A" & lZeile & ":H" & lZeile).Borders(xlEdgeBottom).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":H" & lZeile).Borders(xlEdgeBottom).Weight = _
xlHairline
.Range("A" & lZeile & ":H" & lZeile).Borders(xlEdgeRight).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":H" & lZeile).Borders(xlEdgeRight).Weight = xlHairline
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).LineStyle = _
xlContinuous
.Range("D" & lZeile & ":H" & lZeile).Borders(xlInsideVertical).LineStyle = _
xlContinuous
.Range("A" & lZeile & ":C" & lZeile).Borders(xlInsideVertical).Weight = _
xlHairline
.Range("D" & lZeile & ":H" & lZeile).Borders(xlInsideVertical).Weight = _
xlHairline
.Range("A" & lZeile & ":D" & lZeile).WrapText = False
.Range("E" & lZeile & ":Y" & lZeile).WrapText = True
Range("A" & lZeile & ":I" & lZeile).Font.Name = "Arial"
Range("A" & lZeile & ":I" & lZeile).Font.Size = 8
Next lIndex
End With
Rows.AutoFit
Range("A6").FormulaR1C1 = "x"
' Bildschirm-Update während der Verarbeitung wieder zulassen
Application.ScreenUpdating = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 'Blattschutz ein
ActiveSheet.EnableSelection = xlUnlockedCells
End Sub
Gruß Dörte