Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

x-Achse wird nicht beschriftet
#1
Hallo,

ich habe einen VBA-Excel-Script erstellt bei dem txt-Files eingelesen
werden und automatisch Diagramme auf Tabellenblättern erzeugt werden.
Bei den ersten zwei Blättern ist auch alles ok.
Nur beim dritten Tabellenblatt steht anstelle vom x-Wert nur eine 1 oder 2.
Kann mir jemand einen Tipp geben ?

Code:
Sub Import_mit_Dialog()
Dim Quelle As Object, Ziel As Object
Dim Datei_1 As String
Dim Datei_2 As String

On Error GoTo Fehler

'Dialog "Datei öffnen" anzeigen
Datei = Application.GetOpenFilename("Excel-Dateien(*.yld),*xls")


'Abbrechen falls keine Datei ausgewählt
If Datei = "Falsch" Then
 MsgBox "keine Datei ausgewählt", , "Abbruch"
 Exit Sub
End If

'Ausgewählte Datei öffnen
Workbooks.Open Filename:=Datei

'Datei einlesen und Variable mit Dateinamen beschreiben
Set Quelle = ActiveWorkbook.Worksheets(1)
Datei_1 = ActiveWorkbook.Worksheets(1).Name

'Tabellenblatt beschreiben und umbenennen
Set Ziel = ThisWorkbook.Worksheets(1)
ThisWorkbook.Worksheets(1).Name = Datei_1

'kopieren und einfügen
Quelle.UsedRange.Copy Ziel.Cells(1, 1)

ActiveWorkbook.Close

   'Yield_Auswertung

   Rows(r + 1).Insert Shift:=xlDown
   
   Range("A1").Select
   ActiveCell.FormulaR1C1 = "Prüfauftrag"
   Range("B1").Select
   ActiveCell.FormulaR1C1 = "Yield in Prozent"
   Range("C1").Select
   ActiveCell.FormulaR1C1 = "Gutprüfung"
   Range("D1").Select
   ActiveCell.FormulaR1C1 = "Schlechtprüfung"
   
 
   Dim LastRow As Long
   Dim Rng1 As Range
   Dim ShName As String
     
           
   
   'Zelle mit Gutstückzähler = 0 löschen
   Dim i
   For i = Cells(Rows.Count, 3).End(xlUp).Row To 1 Step -1
   On Error Resume Next
   If Cells(i, 2).Value = "0" Then
   Rows(i).Delete
   End If
   Next
   
           
   'Letzte Zeile suchen und Diagrammbereich in Variable schreiben
   With ActiveSheet
       LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
       Set Rng1 = .Range("A2:B" & LastRow)
       ShName = .Name
   End With
   
   'Zahlenformat festlegen
   Range("G1:G30").NumberFormat = "#,##0.00"
   
   
   
   'Mittelwertberechnung

   ActiveSheet.Range("F2").Value = "Gesamtyield = "
   ActiveSheet.Range("G2").Value = WorksheetFunction.Average(ActiveSheet.Columns(2))
   ActiveSheet.Range("H2").Value = "%"
   
   
   'Anpassung der Spaltenbreite
   Call ActiveSheet.Columns.AutoFit
   
     
   'Diagramm einfügen
   Charts.Add
   
   
   With ActiveChart
       .ChartType = xlColumnClustered
       .SetSourceData Source:=Rng1
       
       'Beschriftung Diagramm
       .HasTitle = True
       .ChartTitle.Text = "Yield Endprüfung  " & ShName
       .Location Where:=xlLocationAsObject, Name:=ShName
       
                       
   End With
   
   
'Auf Tabelle2 (Blatt2) wechseln
Sheets("Tabelle2").Activate


'Dialog "Datei öffnen" anzeigen
Datei = Application.GetOpenFilename("Excel-Dateien(*.yld),*xls")


'Abbrechen falls keine Datei ausgewählt
If Datei = "Falsch" Then
 MsgBox "keine Datei ausgewählt", , "Abbruch"
 Exit Sub
End If

'Ausgewählte Datei öffnen
Workbooks.Open Filename:=Datei

'Datei einlesen und Variable mit Dateinamen beschreiben
Set Quelle = ActiveWorkbook.Worksheets(1)
Datei_2 = ActiveWorkbook.Worksheets(1).Name

'Tabellenblatt beschreiben und umbenennen
Set Ziel = ThisWorkbook.Worksheets(2)
ThisWorkbook.Worksheets(2).Name = Datei_2


'kopieren und einfügen
Quelle.UsedRange.Copy Ziel.Cells(1, 1)



ActiveWorkbook.Close

   'Yield_Auswertung

   Rows(r + 1).Insert Shift:=xlDown
   
   Range("A1").Select
   ActiveCell.FormulaR1C1 = "Prüfauftrag"
   Range("B1").Select
   ActiveCell.FormulaR1C1 = "Yield in Prozent"
   Range("C1").Select
   ActiveCell.FormulaR1C1 = "Gutprüfung"
   Range("D1").Select
   ActiveCell.FormulaR1C1 = "Schlechtprüfung"
               
             
   
   'Zelle mit Gutstückzähler = 0 löschen
   For i = Cells(Rows.Count, 3).End(xlUp).Row To 1 Step -1
   On Error Resume Next
   If Cells(i, 2).Value = "0" Then
   Rows(i).Delete
   End If
   Next
   
           
   'Letzte Zelle suchen und Bereich festlegen
   With ActiveSheet
       LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
       Set Rng1 = .Range("A2:B" & LastRow)
       ShName = .Name
   End With
   
   'Zahlenformat festlegen
   Range("G1:G30").NumberFormat = "#,##0.00"
   
   
   
   'Mittelwertberechnung

   ActiveSheet.Range("F2").Value = "Gesamtyield = "
   ActiveSheet.Range("G2").Value = WorksheetFunction.Average(ActiveSheet.Columns(2))
   ActiveSheet.Range("H2").Value = "%"
   
   
   'Anpassung der Spaltenbreite
   Call ActiveSheet.Columns.AutoFit
   
     
   'Diagramm einfügen
   Charts.Add
   
   
   With ActiveChart
       .ChartType = xlColumnClustered
       .SetSourceData Source:=Rng1
       
       'Beschriftung Diagramm
       .HasTitle = True
       .ChartTitle.Text = "Yield Endprüfung  " & ShName
 
       .Location Where:=xlLocationAsObject, Name:=ShName
       
                       
   End With

'Auf Tabelle3 (Blatt3) wechseln
Sheets("Tabelle3").Activate

Dim LastRow_Gesamt As Long
   Dim Rng1_Gesamt As Range
   Dim ShName_Gesamt As String
 
'Gesamtyield für ausgewählte Monate ausgeben
   ActiveSheet.Range("A2").Value = "Gesamtyield = "
   ActiveSheet.Range("D2").Value = "%"

   ActiveSheet.Range("A3").Value = "Gesamtyield = "
   ActiveSheet.Range("D3").Value = "%"
   

'Kopieren und Einfügen aus Tabelle1 und Tabelle2 in Tabelle3
   Sheets(Datei_1).Range("G2").Copy
   Range("C2").PasteSpecial Paste:=xlPasteAll
   Application.CutCopyMode = False

   Sheets(Datei_2).Range("G2").Copy
   Range("C3").PasteSpecial Paste:=xlPasteAll
   Application.CutCopyMode = False
   
'Tabellenblattname in Zellen aus den Variablen schreiben
   ActiveSheet.Range("B2").Value = Datei_1
   ActiveSheet.Range("B3").Value = Datei_2

'Blatt 3 umbenennen
ThisWorkbook.Worksheets(3).Name = "Gesamtyield"

'Anpassung der Spaltenbreite
   Call ActiveSheet.Columns.AutoFit
   
'Letzte Zelle suchen und Bereich festlegen
   With ActiveSheet
       LastRow_Gesamt = .Range("B" & .Rows.Count).End(xlUp).Row
       Set Rng1_Gesamt = .Range("B2:C" & LastRow)
       
       ShName_Gesamt = .Name
   End With
   
'Diagramm einfügen
   Charts.Add
   
   
   With ActiveChart
       
       .ChartType = xlColumnClustered
       .SetSourceData Source:=Rng1_Gesamt
       
       'Beschriftung Diagramm
       .HasTitle = True
       .ChartTitle.Text = "Yield Endprüfung  " & ShName_Gesamt
       
       
       .Location Where:=xlLocationAsObject, Name:=ShName_Gesamt
       
                       
   End With
   


'Speicher freigeben
Set Quelle = Nothing
Set Ziel = Nothing

Exit Sub

Fehler:
Set Quelle = Nothing
Set Ziel = Nothing

   MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _
   & "Beschreibung: " & Err.Description _
   , vbCritical, "Fehler"
   
End Sub


Sub Import_mit_Dialog()
Dim Quelle As Object, Ziel As Object
Dim Datei_1 As String
Dim Datei_2 As String

On Error GoTo Fehler

'Dialog "Datei öffnen" anzeigen
Datei = Application.GetOpenFilename("Excel-Dateien(*.yld),*xls")


'Abbrechen falls keine Datei ausgewählt
If Datei = "Falsch" Then
 MsgBox "keine Datei ausgewählt", , "Abbruch"
 Exit Sub
End If

'Ausgewählte Datei öffnen
Workbooks.Open Filename:=Datei

'Datei einlesen und Variable mit Dateinamen beschreiben
Set Quelle = ActiveWorkbook.Worksheets(1)
Datei_1 = ActiveWorkbook.Worksheets(1).Name

'Tabellenblatt beschreiben und umbenennen
Set Ziel = ThisWorkbook.Worksheets(1)
ThisWorkbook.Worksheets(1).Name = Datei_1

'kopieren und einfügen
Quelle.UsedRange.Copy Ziel.Cells(1, 1)

ActiveWorkbook.Close

   'Yield_Auswertung

   Rows(r + 1).Insert Shift:=xlDown
   
   Range("A1").Select
   ActiveCell.FormulaR1C1 = "Prüfauftrag"
   Range("B1").Select
   ActiveCell.FormulaR1C1 = "Yield in Prozent"
   Range("C1").Select
   ActiveCell.FormulaR1C1 = "Gutprüfung"
   Range("D1").Select
   ActiveCell.FormulaR1C1 = "Schlechtprüfung"
   
 
   Dim LastRow As Long
   Dim Rng1 As Range
   Dim ShName As String
     
           
   
   'Zelle mit Gutstückzähler = 0 löschen
   Dim i
   For i = Cells(Rows.Count, 3).End(xlUp).Row To 1 Step -1
   On Error Resume Next
   If Cells(i, 2).Value = "0" Then
   Rows(i).Delete
   End If
   Next
   
           
   'Letzte Zeile suchen und Diagrammbereich in Variable schreiben
   With ActiveSheet
       LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
       Set Rng1 = .Range("A2:B" & LastRow)
       ShName = .Name
   End With
   
   'Zahlenformat festlegen
   Range("G1:G30").NumberFormat = "#,##0.00"
   
   
   
   'Mittelwertberechnung

   ActiveSheet.Range("F2").Value = "Gesamtyield = "
   ActiveSheet.Range("G2").Value = WorksheetFunction.Average(ActiveSheet.Columns(2))
   ActiveSheet.Range("H2").Value = "%"
   
   
   'Anpassung der Spaltenbreite
   Call ActiveSheet.Columns.AutoFit
   
     
   'Diagramm einfügen
   Charts.Add
   
   
   With ActiveChart
       .ChartType = xlColumnClustered
       .SetSourceData Source:=Rng1
       
       'Beschriftung Diagramm
       .HasTitle = True
       .ChartTitle.Text = "Yield Endprüfung  " & ShName
       .Location Where:=xlLocationAsObject, Name:=ShName
       
                       
   End With
   
   
'Auf Tabelle2 (Blatt2) wechseln
Sheets("Tabelle2").Activate


'Dialog "Datei öffnen" anzeigen
Datei = Application.GetOpenFilename("Excel-Dateien(*.yld),*xls")


'Abbrechen falls keine Datei ausgewählt
If Datei = "Falsch" Then
 MsgBox "keine Datei ausgewählt", , "Abbruch"
 Exit Sub
End If

'Ausgewählte Datei öffnen
Workbooks.Open Filename:=Datei

'Datei einlesen und Variable mit Dateinamen beschreiben
Set Quelle = ActiveWorkbook.Worksheets(1)
Datei_2 = ActiveWorkbook.Worksheets(1).Name

'Tabellenblatt beschreiben und umbenennen
Set Ziel = ThisWorkbook.Worksheets(2)
ThisWorkbook.Worksheets(2).Name = Datei_2


'kopieren und einfügen
Quelle.UsedRange.Copy Ziel.Cells(1, 1)



ActiveWorkbook.Close

   'Yield_Auswertung

   Rows(r + 1).Insert Shift:=xlDown
   
   Range("A1").Select
   ActiveCell.FormulaR1C1 = "Prüfauftrag"
   Range("B1").Select
   ActiveCell.FormulaR1C1 = "Yield in Prozent"
   Range("C1").Select
   ActiveCell.FormulaR1C1 = "Gutprüfung"
   Range("D1").Select
   ActiveCell.FormulaR1C1 = "Schlechtprüfung"
               
             
   
   'Zelle mit Gutstückzähler = 0 löschen
   For i = Cells(Rows.Count, 3).End(xlUp).Row To 1 Step -1
   On Error Resume Next
   If Cells(i, 2).Value = "0" Then
   Rows(i).Delete
   End If
   Next
   
           
   'Letzte Zelle suchen und Bereich festlegen
   With ActiveSheet
       LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
       Set Rng1 = .Range("A2:B" & LastRow)
       ShName = .Name
   End With
   
   'Zahlenformat festlegen
   Range("G1:G30").NumberFormat = "#,##0.00"
   
   
   
   'Mittelwertberechnung

   ActiveSheet.Range("F2").Value = "Gesamtyield = "
   ActiveSheet.Range("G2").Value = WorksheetFunction.Average(ActiveSheet.Columns(2))
   ActiveSheet.Range("H2").Value = "%"
   
   
   'Anpassung der Spaltenbreite
   Call ActiveSheet.Columns.AutoFit
   
     
   'Diagramm einfügen
   Charts.Add
   
   
   With ActiveChart
       .ChartType = xlColumnClustered
       .SetSourceData Source:=Rng1
       
       'Beschriftung Diagramm
       .HasTitle = True
       .ChartTitle.Text = "Yield Endprüfung  " & ShName
 
       .Location Where:=xlLocationAsObject, Name:=ShName
       
                       
   End With

'Auf Tabelle3 (Blatt3) wechseln
Sheets("Tabelle3").Activate

Dim LastRow_Gesamt As Long
   Dim Rng1_Gesamt As Range
   Dim ShName_Gesamt As String
 
'Gesamtyield für ausgewählte Monate ausgeben
   ActiveSheet.Range("A2").Value = "Gesamtyield = "
   ActiveSheet.Range("D2").Value = "%"

   ActiveSheet.Range("A3").Value = "Gesamtyield = "
   ActiveSheet.Range("D3").Value = "%"
   

'Kopieren und Einfügen aus Tabelle1 und Tabelle2 in Tabelle3
   Sheets(Datei_1).Range("G2").Copy
   Range("C2").PasteSpecial Paste:=xlPasteAll
   Application.CutCopyMode = False

   Sheets(Datei_2).Range("G2").Copy
   Range("C3").PasteSpecial Paste:=xlPasteAll
   Application.CutCopyMode = False
   
'Tabellenblattname in Zellen aus den Variablen schreiben
   ActiveSheet.Range("B2").Value = Datei_1
   ActiveSheet.Range("B3").Value = Datei_2

'Blatt 3 umbenennen
ThisWorkbook.Worksheets(3).Name = "Gesamtyield"

'Anpassung der Spaltenbreite
   Call ActiveSheet.Columns.AutoFit
   
'Letzte Zelle suchen und Bereich festlegen
   With ActiveSheet
       LastRow_Gesamt = .Range("B" & .Rows.Count).End(xlUp).Row
       Set Rng1_Gesamt = .Range("B2:C" & LastRow)
       
       ShName_Gesamt = .Name
   End With
   
'Diagramm einfügen
   Charts.Add
   
   
   With ActiveChart
       
       .ChartType = xlColumnClustered
       .SetSourceData Source:=Rng1_Gesamt
       
       'Beschriftung Diagramm
       .HasTitle = True
       .ChartTitle.Text = "Yield Endprüfung  " & ShName_Gesamt
       
       
       .Location Where:=xlLocationAsObject, Name:=ShName_Gesamt
       
                       
   End With
   


'Speicher freigeben
Set Quelle = Nothing
Set Ziel = Nothing

Exit Sub

Fehler:
Set Quelle = Nothing
Set Ziel = Nothing

   MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _
   & "Beschreibung: " & Err.Description _
   , vbCritical, "Fehler"
   
End Sub

Danke und Gruß im voraus

Günti
Antworten Top
#2
Hallo Günti,

prüfe mal Rng1_Gesamt, das stimmt eventuell nicht, bezieht sich eventuell nur auf B2:C2
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#3
Hallo André,

danke das war die Lösung.
Ich habe den Zellbereich fest auf

Set Rng1_Gesamt = .Range ("A2:B3")

gesetzt, da ich hier nicht mehr Zellen brauche.

Ich verstehe nur nicht, dass ich das gleiche mit mehreren Zellen in Tabelle1
und Tabelle2 mache und da funktioniert es.

Danke und Gruß
Günti
Antworten Top
#4
Hallo,

ich meine natürlich ("B2:C3")

Gruß
Günti
Antworten Top
#5
Hallo an alle,

es funktioniert alles, ausser dass ich auf dem dritten Tabellenblatt
keine Überschrift für das Diagramm angezeigt bekomme.
Auf den ersten beiden Tabellenblättern funktioniert es doch.

Was mache ich falsch ?

Gruß
Günti
Antworten Top
#6
Hallo Günti,

das lässt sich jetzt auch kaum feststellen. Du hast ja für das 3. Diagramm einen identischen Code, von daher sollte es funktionieren. Und wenn es einen Fehler gibt, sollte ja eine Meldung kommen.
Setze doch erst mal in die Zeile
.HasTitle = True
einen Haltepunkt und gehe mit F8 schrittweise weiter und schaue bei jedem Schritt, was sich am Diagramm tut.
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#7
Hallo André,

wenn ich beim dritten Diagramm einen Haltepunkt setze und weitertippe
passiert einfach nichts. Es wird nichts in das Diagramm eingetragen.

Bei den ersten beiden Diagrammen kann ich das mit einem Haltepunkt schön nachverfolgen
wie der Diagrammtitel eingetragen wird.

Ich weiß nicht mehr weiter.

Gruß
Günti
Antworten Top
#8
Hallo Günti,

dann wird eventuell was mit der Variable nicht stimmen.
.ChartTitle.Text = "Yield Endprüfung " & ShName_Gesamt

Zwei Dinge.

Test1: Nimm mal die Variable ShName_Gesamt in die Überwachung und schaue, ob da was korrektes drin steht oder ein Fehler angezeigt wird.
wenn das nichts bringt
Test2: Kommentiere mal die ganzen On Error ... aus. Eventuell erhälst Du dadurch eine Fehlermeldung, die uns weiter bringt.
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#9
Hallo André,

in der Variable ShName_Gesamt steht laut Überwachungsfenster gar nichts drin.

Wenn ich die On Error rauskommentiere kommt die folgende Fehlermeldung:

Laufzeitfehler
Dieses Objekt besitzt keinen Titel.

Wenn ich auf Debuggen gehe springt er in die Zeile:

      .ChartTitle.Text = ShName_Gesamt


Danke im voraus und Gruß
Günter
Antworten Top
#10
Hallo Günter,

wenn nichts drin steht, ist das Makro wohl noch nicht gelaufen? Die Variable wird ein paar Zeilen über dem Diagramm mit dem Namen des aktiven Blattes gefüllt.

Probiere doch mal den Titel statt mit .HasTitle so zu setzen. Eventuell geht das schon in 2007
.SetElement (msoElementChartTitleAboveChart)
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste