Makro Problem in Excel

[Crash]

Hallo zusammen,

nachdem ich jetzt mehrere Tage verbracht habe den Fehler zu finden, wende ich mich an Euch in der Hoffnung das mir jemand helfen kann.

Wahrscheinlich bin ich nur zu Blind...

Ich habe ein Makro in Excel welches mir einen automatischen Seriendruck anstößt.

Innerhalb des Makros sind diverse Formatierungen festgelegt die dem Drucksheet sagen was zu drucken ist.

Nun ist es aber so, dass wenn der Preis in Euro mit z.B. ,90 oder, 80 endet ist die letzte Null nicht mit auf dem Ausdruck.

Die muss aber zwingend mit auf den Ausdruck.

Hier mal das Makro

Code:

Sub Seriendruck1()

For a = 1 To Sheets("Drucktabelle").Cells(1, 1).End(xlDown).Row
   Sheets("Druckvorlage").Cells(2, 6).Value = CStr(Sheets("Drucktabelle").Cells(a, 1))
    Sheets("G+").Cells(1, 1).Value = CStr(Sheets("Drucktabelle").Cells(a, 2))
    Sheets("G+").Cells(1, 2).Value = CStr(Sheets("Drucktabelle").Cells(a, 3))
    Sheets("G+").Cells(1, 3).Value = CStr(Sheets("Drucktabelle").Cells(a, 7))
Sheets("Druckvorlage").Activate
 Sheets("Druckvorlage").Cells(36, 1).Value = CStr(Sheets("Druckvorlage").Cells(3, 6))
Range("B36").Select
    
    Dim listrWert As String
    
    Selection.NumberFormat = "@"
    
    listrWert = ActiveCell.Value
    
    With Selection
        .HorizontalAlignment = xlCenter
    End With

    ActiveCell.FormulaR1C1 = listrWert
        
        Select Case Len(ActiveCell.Value)
            Case 5
                With ActiveCell.Characters(Start:=1, Length:=3).Font
                    .Name = "Eurostile OT Black"
                    .FontStyle = "Standard"
                    .Size = 170
                    .Color = RGB(239, 124, 0)
                
                End With
                With ActiveCell.Characters(Start:=4, Length:=2).Font
                    .Name = "Eurostile OT Black"
                    
                    .Size = 60
                    .Superscript = True
                    .Color = RGB(239, 124, 0)
                End With
                
            Case 6
                With ActiveCell.Characters(Start:=1, Length:=2).Font
                    .Name = "Presto_Franklin Gothic Demi Con"
                    .FontStyle = "Standard"
                    .Size = 170
                    .Color = RGB(239, 124, 0)
                End With
                With ActiveCell.Characters(Start:=3, Length:=2).Font
                    .Name = "Eurostile OT Black"
                   
                    .Size = 60
                    .Superscript = True
                    .Color = RGB(239, 124, 0)
                End With
                
                With ActiveCell.Characters(Start:=6, Length:=1).Font
                    .Name = "Presto_Franklin Gothic Demi Con"
                    .FontStyle = "Standard"
                    .Size = 170
                    .Color = RGB(239, 124, 0)
                End With                              
                
            Case 7
                With ActiveCell.Characters(Start:=1, Length:=3).Font
                    .Name = "Eurostile OT Black"
                    .FontStyle = "Standard"
                    .Size = 170
                    .Color = RGB(239, 124, 0)
                End With
                With ActiveCell.Characters(Start:=4, Length:=3).Font
                    .Name = "Eurostile OT Black"                  
                    .Size = 60
                    .Superscript = True
                    .Color = RGB(239, 124, 0)
                End With
                With ActiveCell.Characters(Start:=7, Length:=1).Font
                    .Name = "Presto_Franklin Gothic Demi Con"
                    .FontStyle = "Standard"
                    .Size = 170
                    .Color = RGB(239, 124, 0)
                End With        
                              
              Case 8
                With ActiveCell.Characters(Start:=1, Length:=4).Font
                    .Name = "Eurostile OT Black"
                    .FontStyle = "Standard"
                    .Size = 170
                    .Color = RGB(239, 124, 0)
                End With
                With ActiveCell.Characters(Start:=5, Length:=3).Font
                    .Name = "Eurostile OT Black"                  
                    .Size = 60
                    .Superscript = True
                    .Color = RGB(239, 124, 0)
                End With
                With ActiveCell.Characters(Start:=8, Length:=1).Font
                    .Name = "Presto_Franklin Gothic Demi Con"
                    .FontStyle = "Standard"
                    .Size = 170
                    .Color = RGB(239, 124, 0)
                End With      
         
            Case 9
                With ActiveCell.Characters(Start:=1, Length:=5).Font
                    .Name = "Eurostile OT Black"
                    .FontStyle = "Standard"
                    .Size = 170
                    .Color = RGB(239, 124, 0)
                End With
                With ActiveCell.Characters(Start:=6, Length:=3).Font
                    .Name = "Eurostile OT Black"                  
                    .Size = 60
                    .Superscript = True
                    .Color = RGB(239, 124, 0)
                End With
                With ActiveCell.Characters(Start:=9, Length:=1).Font
                    .Name = "Presto_Franklin Gothic Demi Con"
                    .FontStyle = "Standard"
                    .Size = 170
                    .Color = RGB(239, 124, 0)
                End With
        
        Case 10
                With ActiveCell.Characters(Start:=1, Length:=6).Font
                    .Name = "Eurostile OT Black"
                    .FontStyle = "Standard"
                    .Size = 170
                    .Color = RGB(239, 124, 0)
                End With
                With ActiveCell.Characters(Start:=7, Length:=3).Font
                    .Name = "Eurostile OT Black"                  
                    .Size = 60
                    .Superscript = True
                    .Color = RGB(239, 124, 0)
                End With
                With ActiveCell.Characters(Start:=10, Length:=1).Font
                    .Name = "Presto_Franklin Gothic Demi Con"
                    .FontStyle = "Standard"
                    .Size = 170
                    .Color = RGB(239, 124, 0)
                End With
        
              Case 11
                With ActiveCell.Characters(Start:=1, Length:=7).Font
                    .Name = "Eurostile OT Black"
                    .FontStyle = "Standard"
                    .Size = 170
                    .Color = RGB(239, 124, 0)
                End With
                With ActiveCell.Characters(Start:=8, Length:=3).Font
                    .Name = "PEurostile OT Black"                  
                    .Size = 60
                    .Superscript = True
                    .Color = RGB(239, 124, 0)
                End With
                With ActiveCell.Characters(Start:=11, Length:=1).Font
                    .Name = "Presto_Franklin Gothic Demi Con"
                    .FontStyle = "Standard"
                    .Size = 170
                    .Color = RGB(239, 124, 0)
                End With
        
        End Select
        
    Selection.NumberFormat = "0.00"
    
  Sheets("Druckvorlage").Cells(47, 7).Value = CStr(Sheets("Druckvorlage").Cells(4, 6))
  
  If Cells(47, 7).Value Like "" Then
    
    Else
    
  ActiveSheet.Shapes.AddLine(450, 780, 550, 830).Select
  Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Weight = 4#
    Selection.ShapeRange.Name = "Linie1"
    Selection.ShapeRange.Line.ForeColor.RGB = RGB(255, 0, 0)

 ActiveSheet.Shapes.AddLine(450, 830, 550, 780).Select
  Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Weight = 4#
    Selection.ShapeRange.Name = "Linie2"
    Selection.ShapeRange.Line.ForeColor.RGB = RGB(255, 0, 0)
  
  End If
  
  Range("h47").Select      
    Dim listrWert2 As String   
    Selection.NumberFormat = "@"   
    listrWert2 = ActiveCell.Value   
    With Selection
        .HorizontalAlignment = xlRight
    End With

    ActiveCell.FormulaR1C1 = listrWert2       
        Select Case Len(ActiveCell.Value)
            Case 5
                With ActiveCell.Characters(Start:=1, Length:=3).Font
                    .Name = "Presto_Franklin Gothic Demi Con"
                    .FontStyle = "Standard"
                    .Size = 48
                    .Color = RGB(239, 124, 0)
                
                End With
                With ActiveCell.Characters(Start:=4, Length:=2).Font
                    .Name = "Presto_Franklin Gothic Demi Con"
                    .FontStyle = "Standard"
                    .Size = 24
                    .Superscript = True
                    .Color = RGB(239, 124, 0)
                End With
            Case 6
                With ActiveCell.Characters(Start:=1, Length:=4).Font
                    .Name = "Presto_Franklin Gothic Demi Con"
                    .FontStyle = "Standard"
                    .Size = 48
                    .Color = RGB(239, 124, 0)
                End With
                With ActiveCell.Characters(Start:=5, Length:=2).Font
                    .Name = "Presto_Franklin Gothic Demi Con"
                    .FontStyle = "Standard"
                    .Size = 24
                    .Superscript = True
                    .Color = RGB(239, 124, 0)
                End With
            Case 7
                With ActiveCell.Characters(Start:=1, Length:=5).Font
                    .Name = "Presto_Franklin Gothic Demi Con"
                    .FontStyle = "Standard"
                    .Size = 48
                    .Color = RGB(239, 124, 0)
                End With
                With ActiveCell.Characters(Start:=6, Length:=2).Font
                    .Name = "Presto_Franklin Gothic Demi Con"
                    .FontStyle = "Standard"
                    .Size = 24
                    .Superscript = True
                    .Color = RGB(239, 124, 0)
                End With
            Case 8
                With ActiveCell.Characters(Start:=1, Length:=6).Font
                    .Name = "Presto_Franklin Gothic Demi Con"
                    .FontStyle = "Standard"
                    .Size = 48
                    .Color = RGB(239, 124, 0)
                End With
                With ActiveCell.Characters(Start:=7, Length:=2).Font
                    .Name = "Presto_Franklin Gothic Demi Con"
                    .FontStyle = "Standard"
                    .Size = 24
                    .Superscript = True
                    .Color = RGB(239, 124, 0)
                End With
        End Select
        
    Selection.NumberFormat = "0.00"
    
 If Cells(2, 6).Value Like "ArtNr." Then    
    Else   
Dim Druck As Integer   
Druck = Worksheets("Drucktabelle").Range("q13").Value
For b = 1 To Druck
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Next b
 End If

Dim Shl1 As Object
For Each Shl1 In ActiveSheet.Shapes
If Shl1.Name = "Linie1" Then
              Shl1.Delete
End If

Next

Dim Shl2 As Object
For Each Shl2 In ActiveSheet.Shapes
If Shl2.Name = "Linie2" Then
              Shl2.Delete
End If
Next
Next a
Sheets("Drucktabelle").Activate

End Sub

Ich hoffe das wer helfen kann.

Danke

[cysu11]

Hi Crash,

lade bitte deine Beispielmappe hoch, wo man das testen kann!

LG
Alexandra

[Crash]

Hallo,

das kann ich leider aus Datenschutzgründen nicht.

Sollte aufgrund dessen keine Hilfe möglich sein, dann probiere ich weiter rum.

[WillWissen]

Hallo,

das kann ich leider aus Datenschutzgründen nicht.

Alexandra hat nicht deine Originaltabelle verlangt, sondern eine Beispieltabelle. sie sollte nur vom Aufbau her deinem original entsprechen; ansonsten die sensiblen Daten bitte anonymisieren.

[Crash]

Was ich halt nicht verstehe ist das obwohl der richtige Code 

Selection.NumberFormat = "0.00"

drin ist klappt es nicht.

---

Wenn ich eine Beispieltabelle hätte würde ich die gerne hochladen.

Die Daten kann ich auch nicht mal eben rausnehmen, weil sonst die ganze Excel nicht funktioniert.

Die sind alle Bestandteil des mittlerweilen 15MB großen Konstrukts.

Dennoch Danke für den Versuch

[Käpt'n Blaubär]

Hallo,

Was ich halt nicht verstehe ist das obwohl der richtige Code ....

... und ohne Beispieldatei wird das voraussichtlich auch so bleiben.

[Crash]

Hat jetzt länger gedauert und der Drucker reagiert nicht aber der Fehler wie beschrieben ist vorhanden.

Es geht um die Zelle A36 im Reiter Druckvorlage.

Sobald man das Makro drückt ist die Null weg.

---

Hier die Beispieldatei

[Steffl]

Hallo,

du überträgst hier

Code:

Sheets("Druckvorlage").Cells(36, 1).Value = CStr(Sheets("Druckvorlage").Cells(3, 6))

einen Text, was Du anhand des Fehlerindikator auch sehen könntest. Ob die Umwandlung in Text sein muss, kannst nur Du entscheiden.

[Crash]

Hi,

Der Text der da übertragen wird, ist der Preis aus der Druckvorlage. 

Sobald du auf das Makro für das Drucken klickst, formatiert das VBA Makro die Null weg. Das hat mit der Textformatierung nichts zu tun.

Oder sehe ich das falsch?

[Steffl]

Hallo,

ich glaube schon. Ich habe in der Zelle D2 eine Zahl eingegeben. Diese Zelle mit zwei Stellen nach dem Komma formatiert und folgendes Makro gestartet.

Code:

Sub prcX()

  Range("B2").Value = CStr(Range("D2").Value)

End Sub

und schau dir die Zahl in der Zelle B2 an und betrachte dir auch die Ausrichtung.

Arbeitsblatt mit dem Namen 'Tabelle1'
	A	B	C	D	E
1
2		23,9		23,90
3

Zelle	Format	Wert
D2	0,00	23,9

Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg