|
|
' =========================================
|
|
|
' 1) Widerstandsdiagramme für die Standard Messung
|
|
|
' =========================================
|
|
|
Sub AktualisiereXYDiagrammWiderstand()
|
|
|
Dim datenWs As Worksheet
|
|
|
Dim diagrammWs As Worksheet
|
|
|
Dim chartObj As ChartObject
|
|
|
Dim diagramm As Chart
|
|
|
Dim xRange As Range
|
|
|
Dim yRange As Range
|
|
|
Dim letzteSpalte As Long
|
|
|
Dim letzteZeile As Long
|
|
|
Dim i As Long
|
|
|
' Arbeitsblätter definieren
|
|
|
Set datenWs = ThisWorkbook.Worksheets(1) ' Blatt mit den Daten
|
|
|
Set diagrammWs = ThisWorkbook.Worksheets(3) ' Blatt mit dem Diagramm
|
|
|
' Diagramm definieren
|
|
|
Set chartObj = diagrammWs.ChartObjects(1) ' Diagrammname anpassen
|
|
|
Set diagramm = chartObj.Chart
|
|
|
' Letzte Zeile und Spalte der Daten finden
|
|
|
letzteZeile = datenWs.Cells(datenWs.Rows.Count, 1).End(xlUp).Row ' X-Werte in Spalte A
|
|
|
letzteSpalte = datenWs.Cells(3, datenWs.Columns.Count).End(xlToLeft).Column ' Y-Werte ab Spalte B
|
|
|
' MsgBox letzteZeile, vbInformation
|
|
|
' MsgBox letzteSpalte, vbInformation
|
|
|
' X-Werte-Bereich definieren (fix in Spalte A, ab Zeile 3)
|
|
|
Set xRange = datenWs.Range(datenWs.Cells(3, 1), datenWs.Cells(letzteZeile, 1)) ' Daten beginnen ab Zeile 3
|
|
|
' Bestehende Datenreihen im Diagramm entfernen
|
|
|
Do While diagramm.SeriesCollection.Count > 0
|
|
|
diagramm.SeriesCollection(1).Delete
|
|
|
Loop
|
|
|
' Neue Datenreihen hinzufügen
|
|
|
For i = 2 To letzteSpalte ' Y-Werte beginnen in Spalte B
|
|
|
Set yRange = datenWs.Range(datenWs.Cells(3, i), datenWs.Cells(letzteZeile, i))
|
|
|
' Neue Datenreihe hinzufügen
|
|
|
With diagramm.SeriesCollection.NewSeries
|
|
|
.Name = datenWs.Cells(2, i).Value ' Name der Reihe aus der Kopfzeile (Zeile 1)
|
|
|
.XValues = xRange
|
|
|
.Values = yRange
|
|
|
.Smooth = False ' Glätten ausschalten
|
|
|
End With
|
|
|
Next i
|
|
|
End Sub
|
|
|
' =========================================
|
|
|
' 2) Kraftdiagramme für die Standard Messung
|
|
|
' =========================================
|
|
|
Sub AktualisiereXYDiagrammKraft()
|
|
|
Dim datenWs As Worksheet
|
|
|
Dim diagrammWs As Worksheet
|
|
|
Dim chartObj As ChartObject
|
|
|
Dim diagramm As Chart
|
|
|
Dim xRange As Range
|
|
|
Dim yRange As Range
|
|
|
Dim letzteSpalte As Long
|
|
|
Dim letzteZeile As Long
|
|
|
Dim i As Long
|
|
|
' Arbeitsblätter definieren
|
|
|
Set datenWs = ThisWorkbook.Worksheets(2) ' Blatt mit den Daten
|
|
|
Set diagrammWs = ThisWorkbook.Worksheets(4) ' Blatt mit dem Diagramm
|
|
|
' Diagramm definieren
|
|
|
Set chartObj = diagrammWs.ChartObjects(1) ' Diagrammname anpassen
|
|
|
Set diagramm = chartObj.Chart
|
|
|
' Letzte Zeile und Spalte der Daten finden
|
|
|
letzteZeile = datenWs.Cells(datenWs.Rows.Count, 1).End(xlUp).Row ' X-Werte in Spalte A
|
|
|
letzteSpalte = datenWs.Cells(3, datenWs.Columns.Count).End(xlToLeft).Column ' Y-Werte ab Spalte B
|
|
|
'MsgBox letzteZeile, vbInformation
|
|
|
'MsgBox letzteSpalte, vbInformation
|
|
|
' X-Werte-Bereich definieren (fix in Spalte A, ab Zeile 3)
|
|
|
Set xRange = datenWs.Range(datenWs.Cells(3, 1), datenWs.Cells(letzteZeile, 1)) ' Daten beginnen ab Zeile 3
|
|
|
' Bestehende Datenreihen im Diagramm entfernen
|
|
|
Do While diagramm.SeriesCollection.Count > 0
|
|
|
diagramm.SeriesCollection(1).Delete
|
|
|
Loop
|
|
|
' Neue Datenreihen hinzufügen
|
|
|
For i = 2 To letzteSpalte ' Y-Werte beginnen in Spalte B
|
|
|
Set yRange = datenWs.Range(datenWs.Cells(3, i), datenWs.Cells(letzteZeile, i))
|
|
|
' Neue Datenreihe hinzufügen
|
|
|
With diagramm.SeriesCollection.NewSeries
|
|
|
.Name = datenWs.Cells(2, i).Value ' Name der Reihe aus der Kopfzeile (Zeile 1)
|
|
|
.XValues = xRange
|
|
|
.Values = yRange
|
|
|
.Smooth = False ' Glätten ausschalten
|
|
|
End With
|
|
|
Next i
|
|
|
End Sub
|
|
|
' =========================================
|
|
|
' 5) Widerstandsdiagramme für die Inkrement-Messung (Position-Gruppierung)
|
|
|
' =========================================
|
|
|
Sub AktualisiereXYDiagrammInkrementWiderstandPosition()
|
|
|
Dim wsBasis As Worksheet
|
|
|
Dim ws As Worksheet
|
|
|
Dim chartObj As ChartObject
|
|
|
Dim diagramm As Chart
|
|
|
Dim letzteZeile As Long
|
|
|
Dim letzteSpalte As Long
|
|
|
Dim blockAnzahl As Long
|
|
|
Dim startZeile As Long
|
|
|
Dim posIndex As Integer
|
|
|
|
|
|
' Arbeitsblatt "Widerstandsdiagramm" festlegen
|
|
|
Set wsBasis = ThisWorkbook.Worksheets("Widerstandsdiagramm")
|
|
|
|
|
|
' --- Schritt 1: Anzahl der Positions-Blöcke ermitteln ---
|
|
|
' Wir nehmen das erste Messblatt vor "Widerstandsdiagramm" als Referenz
|
|
|
For Each ws In ThisWorkbook.Worksheets
|
|
|
If ws.Index < wsBasis.Index Then
|
|
|
letzteSpalte = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
|
|
|
blockAnzahl = Int(letzteSpalte / 3)
|
|
|
Exit For
|
|
|
End If
|
|
|
Next ws
|
|
|
|
|
|
If blockAnzahl = 0 Then
|
|
|
MsgBox "Keine Datenblöcke gefunden.", vbExclamation
|
|
|
Exit Sub
|
|
|
End If
|
|
|
|
|
|
' --- Schritt 2: Diagramm im Basisblatt für Position 1 aktualisieren ---
|
|
|
Call AktualisiereDiagrammFuerPosition(wsBasis, 1)
|
|
|
|
|
|
' --- Schritt 3: Für jede weitere Position Blatt kopieren und Diagramm anpassen ---
|
|
|
For posIndex = 2 To blockAnzahl
|
|
|
wsBasis.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count-1)
|
|
|
With ActiveSheet
|
|
|
.Name = "Widerstandsdiagramm" & posIndex
|
|
|
Call AktualisiereDiagrammFuerPosition(ActiveSheet, posIndex)
|
|
|
End With
|
|
|
Next posIndex
|
|
|
|
|
|
End Sub
|
|
|
|
|
|
Private Sub AktualisiereDiagrammFuerPosition(wsDiagramm As Worksheet, posIndex As Integer)
|
|
|
Dim ws As Worksheet
|
|
|
Dim chartObj As ChartObject
|
|
|
Dim diagramm As Chart
|
|
|
Dim letzteZeile As Long
|
|
|
Dim datenBereichX As Range
|
|
|
Dim datenBereichY1 As Range
|
|
|
Dim datenReihe As Series
|
|
|
Dim startSpalte As Long
|
|
|
Dim startZeile As Long
|
|
|
Dim reihenName As String
|
|
|
|
|
|
' Diagramm im Blatt suchen
|
|
|
If wsDiagramm.ChartObjects.Count = 0 Then Exit Sub
|
|
|
Set chartObj = wsDiagramm.ChartObjects(1)
|
|
|
Set diagramm = chartObj.Chart
|
|
|
|
|
|
' Vorhandene Datenreihen löschen
|
|
|
Do While diagramm.SeriesCollection.Count > 0
|
|
|
diagramm.SeriesCollection(1).Delete
|
|
|
Loop
|
|
|
|
|
|
' Spalten für gewünschte Position bestimmen
|
|
|
startSpalte = (posIndex - 1) * 3 + 1
|
|
|
startZeile = 3
|
|
|
|
|
|
' Alle Messblätter vor "Widerstandsdiagramm" durchlaufen
|
|
|
For Each ws In ThisWorkbook.Worksheets
|
|
|
If ws.Index < ThisWorkbook.Worksheets("Widerstandsdiagramm").Index Then
|
|
|
letzteZeile = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
|
|
|
If letzteZeile >= startZeile Then
|
|
|
With ws
|
|
|
' X und Y1 für diese Position
|
|
|
Set datenBereichX = .Range(.Cells(startZeile, startSpalte), .Cells(letzteZeile, startSpalte))
|
|
|
Set datenBereichY1 = .Range(.Cells(startZeile, startSpalte + 1), .Cells(letzteZeile, startSpalte + 1))
|
|
|
|
|
|
' Reihenname: Blattname + A1 + Position
|
|
|
reihenName = ws.Name
|
|
|
|
|
|
' Datenreihe hinzufügen
|
|
|
Set datenReihe = diagramm.SeriesCollection.NewSeries
|
|
|
datenReihe.Values = datenBereichY1
|
|
|
datenReihe.XValues = datenBereichX
|
|
|
datenReihe.Name = reihenName
|
|
|
|
|
|
On Error Resume Next
|
|
|
datenReihe.Smooth = False
|
|
|
On Error GoTo 0
|
|
|
End With
|
|
|
End If
|
|
|
End If
|
|
|
Next ws
|
|
|
End Sub
|
|
|
|
|
|
' =========================================
|
|
|
' 6) Kraftdiagramme für die Inkrement-Messung (Position-Gruppierung)
|
|
|
' =========================================
|
|
|
Sub AktualisiereXYDiagrammInkrementKraftPosition()
|
|
|
Dim wsBasis As Worksheet
|
|
|
Dim ws As Worksheet
|
|
|
Dim chartObj As ChartObject
|
|
|
Dim diagramm As Chart
|
|
|
Dim letzteZeile As Long
|
|
|
Dim letzteSpalte As Long
|
|
|
Dim blockAnzahl As Long
|
|
|
Dim posIndex As Integer
|
|
|
|
|
|
' Arbeitsblatt "Kraftdiagramm" festlegen
|
|
|
Set wsBasis = ThisWorkbook.Worksheets("Kraftdiagramm")
|
|
|
|
|
|
' --- Schritt 1: Anzahl der Positions-Blöcke ermitteln ---
|
|
|
' Wir nehmen das erste Messblatt vor "Widerstandsdiagramm" als Referenz
|
|
|
For Each ws In ThisWorkbook.Worksheets
|
|
|
If ws.Index < ThisWorkbook.Worksheets("Widerstandsdiagramm").Index Then
|
|
|
letzteSpalte = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
|
|
|
blockAnzahl = Int(letzteSpalte / 3)
|
|
|
Exit For
|
|
|
End If
|
|
|
Next ws
|
|
|
|
|
|
If blockAnzahl = 0 Then
|
|
|
MsgBox "Keine Datenblöcke gefunden.", vbExclamation
|
|
|
Exit Sub
|
|
|
End If
|
|
|
|
|
|
' --- Schritt 2: Diagramm im Basisblatt für Position 1 aktualisieren ---
|
|
|
Call AktualisiereDiagrammFuerPosition_Kraft(wsBasis, 1)
|
|
|
|
|
|
' --- Schritt 3: Für jede weitere Position Blatt kopieren und Diagramm anpassen ---
|
|
|
For posIndex = 2 To blockAnzahl
|
|
|
wsBasis.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
|
|
|
With ActiveSheet
|
|
|
.Name = "Kraftdiagramm" & posIndex
|
|
|
Call AktualisiereDiagrammFuerPosition_Kraft(ActiveSheet, posIndex)
|
|
|
End With
|
|
|
Next posIndex
|
|
|
End Sub
|
|
|
|
|
|
Private Sub AktualisiereDiagrammFuerPosition_Kraft(wsDiagramm As Worksheet, posIndex As Integer)
|
|
|
Dim ws As Worksheet
|
|
|
Dim chartObj As ChartObject
|
|
|
Dim diagramm As Chart
|
|
|
Dim letzteZeile As Long
|
|
|
Dim datenBereichX As Range
|
|
|
Dim datenBereichY2 As Range
|
|
|
Dim datenReihe As Series
|
|
|
Dim startSpalte As Long
|
|
|
Dim startZeile As Long
|
|
|
Dim reihenName As String
|
|
|
|
|
|
' Diagramm im Blatt suchen
|
|
|
If wsDiagramm.ChartObjects.Count = 0 Then Exit Sub
|
|
|
Set chartObj = wsDiagramm.ChartObjects(1)
|
|
|
Set diagramm = chartObj.Chart
|
|
|
|
|
|
' Vorhandene Datenreihen löschen
|
|
|
Do While diagramm.SeriesCollection.Count > 0
|
|
|
diagramm.SeriesCollection(1).Delete
|
|
|
Loop
|
|
|
|
|
|
' Spalten für gewünschte Position bestimmen
|
|
|
startSpalte = (posIndex - 1) * 3 + 1
|
|
|
startZeile = 3
|
|
|
|
|
|
' Alle Messblätter vor "Widerstandsdiagramm" durchlaufen
|
|
|
For Each ws In ThisWorkbook.Worksheets
|
|
|
If ws.Index < ThisWorkbook.Worksheets("Widerstandsdiagramm").Index Then
|
|
|
letzteZeile = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
|
|
|
If letzteZeile >= startZeile Then
|
|
|
With ws
|
|
|
' X und Y2 für diese Position
|
|
|
Set datenBereichX = .Range(.Cells(startZeile, startSpalte), .Cells(letzteZeile, startSpalte))
|
|
|
Set datenBereichY2 = .Range(.Cells(startZeile, startSpalte + 2), .Cells(letzteZeile, startSpalte + 2))
|
|
|
|
|
|
' Reihenname: Blattname
|
|
|
reihenName = ws.Name
|
|
|
|
|
|
' Datenreihe hinzufügen
|
|
|
Set datenReihe = diagramm.SeriesCollection.NewSeries
|
|
|
datenReihe.Values = datenBereichY2
|
|
|
datenReihe.XValues = datenBereichX
|
|
|
datenReihe.Name = reihenName
|
|
|
|
|
|
On Error Resume Next
|
|
|
datenReihe.Smooth = False
|
|
|
On Error GoTo 0
|
|
|
End With
|
|
|
End If
|
|
|
End If
|
|
|
Next ws
|
|
|
End Sub
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
' =========================================
|
|
|
' 3) Widerstandsdiagramme für die Inkrement-Messung (Messung-Gruppierung)
|
|
|
' =========================================
|
|
|
Sub AktualisiereXYDiagrammInkrementWiderstand()
|
|
|
Dim wsBasis As Worksheet
|
|
|
Dim ws As Worksheet
|
|
|
Dim chartObj As ChartObject
|
|
|
Dim diagramm As Chart
|
|
|
Dim letzteSpalte As Long
|
|
|
Dim blockAnzahl As Long
|
|
|
Dim messungIndex As Integer
|
|
|
|
|
|
' Arbeitsblatt "Widerstandsdiagramm" festlegen
|
|
|
Set wsBasis = ThisWorkbook.Worksheets("Widerstandsdiagramm")
|
|
|
|
|
|
' --- Anzahl der Positions-Blöcke ermitteln (aus erstem Messblatt) ---
|
|
|
For Each ws In ThisWorkbook.Worksheets
|
|
|
If ws.Index < wsBasis.Index Then
|
|
|
letzteSpalte = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
|
|
|
blockAnzahl = Int(letzteSpalte / 3)
|
|
|
Exit For
|
|
|
End If
|
|
|
Next ws
|
|
|
|
|
|
If blockAnzahl = 0 Then
|
|
|
MsgBox "Keine Datenblöcke gefunden.", vbExclamation
|
|
|
Exit Sub
|
|
|
End If
|
|
|
|
|
|
' --- Diagramm im Basisblatt für Messung 1 aktualisieren ---
|
|
|
Call AktualisiereDiagrammFuerMessung_Widerstand(wsBasis, 1, blockAnzahl)
|
|
|
|
|
|
' --- Für jede weitere Messung: Blatt kopieren ---
|
|
|
For messungIndex = 2 To wsBasis.Index - 1
|
|
|
wsBasis.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count-1)
|
|
|
With ActiveSheet
|
|
|
.Name = "Widerstandsdiagramm" & messungIndex
|
|
|
Call AktualisiereDiagrammFuerMessung_Widerstand(ActiveSheet, messungIndex, blockAnzahl)
|
|
|
End With
|
|
|
Next messungIndex
|
|
|
End Sub
|
|
|
|
|
|
Private Sub AktualisiereDiagrammFuerMessung_Widerstand(wsDiagramm As Worksheet, messungNr As Integer, blockAnzahl As Long)
|
|
|
Dim ws As Worksheet
|
|
|
Dim chartObj As ChartObject
|
|
|
Dim diagramm As Chart
|
|
|
Dim letzteZeile As Long
|
|
|
Dim datenBereichX As Range
|
|
|
Dim datenBereichY1 As Range
|
|
|
Dim datenReihe As Series
|
|
|
Dim posIndex As Integer
|
|
|
Dim startSpalte As Long
|
|
|
Dim startZeile As Long
|
|
|
|
|
|
' Diagramm im Blatt suchen
|
|
|
If wsDiagramm.ChartObjects.Count = 0 Then Exit Sub
|
|
|
Set chartObj = wsDiagramm.ChartObjects(1)
|
|
|
Set diagramm = chartObj.Chart
|
|
|
|
|
|
' Vorhandene Datenreihen löschen
|
|
|
Do While diagramm.SeriesCollection.Count > 0
|
|
|
diagramm.SeriesCollection(1).Delete
|
|
|
Loop
|
|
|
|
|
|
startZeile = 3
|
|
|
Set ws = ThisWorkbook.Worksheets(messungNr)
|
|
|
|
|
|
letzteZeile = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
|
|
|
If letzteZeile >= startZeile Then
|
|
|
For posIndex = 1 To blockAnzahl
|
|
|
startSpalte = (posIndex - 1) * 3 + 1
|
|
|
Set datenBereichX = ws.Range(ws.Cells(startZeile, startSpalte), ws.Cells(letzteZeile, startSpalte))
|
|
|
Set datenBereichY1 = ws.Range(ws.Cells(startZeile, startSpalte + 1), ws.Cells(letzteZeile, startSpalte + 1))
|
|
|
|
|
|
Set datenReihe = diagramm.SeriesCollection.NewSeries
|
|
|
datenReihe.Values = datenBereichY1
|
|
|
datenReihe.XValues = datenBereichX
|
|
|
datenReihe.Name = "Position " & posIndex
|
|
|
datenReihe.Smooth = False
|
|
|
Next posIndex
|
|
|
End If
|
|
|
End Sub
|
|
|
|
|
|
' =========================================
|
|
|
' 4) Kraftdiagramme für die Inkrement-Messung (Messung-Gruppierung)
|
|
|
' =========================================
|
|
|
Sub AktualisiereXYDiagrammInkrementKraft()
|
|
|
Dim wsBasis As Worksheet
|
|
|
Dim ws As Worksheet
|
|
|
Dim chartObj As ChartObject
|
|
|
Dim diagramm As Chart
|
|
|
Dim letzteSpalte As Long
|
|
|
Dim blockAnzahl As Long
|
|
|
Dim messungIndex As Integer
|
|
|
|
|
|
' Arbeitsblatt "Kraftdiagramm" festlegen
|
|
|
Set wsBasis = ThisWorkbook.Worksheets("Kraftdiagramm")
|
|
|
|
|
|
' --- Anzahl der Positions-Blöcke ermitteln (aus erstem Messblatt) ---
|
|
|
For Each ws In ThisWorkbook.Worksheets
|
|
|
If ws.Index < ThisWorkbook.Worksheets("Widerstandsdiagramm").Index Then
|
|
|
letzteSpalte = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
|
|
|
blockAnzahl = Int(letzteSpalte / 3)
|
|
|
Exit For
|
|
|
End If
|
|
|
Next ws
|
|
|
|
|
|
If blockAnzahl = 0 Then
|
|
|
MsgBox "Keine Datenblöcke gefunden.", vbExclamation
|
|
|
Exit Sub
|
|
|
End If
|
|
|
|
|
|
' --- Diagramm im Basisblatt für Messung 1 aktualisieren ---
|
|
|
Call AktualisiereDiagrammFuerMessung_Kraft(wsBasis, 1, blockAnzahl)
|
|
|
|
|
|
' --- Für jede weitere Messung: Blatt kopieren ---
|
|
|
For messungIndex = 2 To ThisWorkbook.Worksheets("Widerstandsdiagramm").Index - 1
|
|
|
wsBasis.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
|
|
|
With ActiveSheet
|
|
|
.Name = "Kraftdiagramm" & messungIndex
|
|
|
Call AktualisiereDiagrammFuerMessung_Kraft(ActiveSheet, messungIndex, blockAnzahl)
|
|
|
End With
|
|
|
Next messungIndex
|
|
|
End Sub
|
|
|
|
|
|
Private Sub AktualisiereDiagrammFuerMessung_Kraft(wsDiagramm As Worksheet, messungNr As Integer, blockAnzahl As Long)
|
|
|
Dim ws As Worksheet
|
|
|
Dim chartObj As ChartObject
|
|
|
Dim diagramm As Chart
|
|
|
Dim letzteZeile As Long
|
|
|
Dim datenBereichX As Range
|
|
|
Dim datenBereichY2 As Range
|
|
|
Dim datenReihe As Series
|
|
|
Dim posIndex As Integer
|
|
|
Dim startSpalte As Long
|
|
|
Dim startZeile As Long
|
|
|
|
|
|
' Diagramm im Blatt suchen
|
|
|
If wsDiagramm.ChartObjects.Count = 0 Then Exit Sub
|
|
|
Set chartObj = wsDiagramm.ChartObjects(1)
|
|
|
Set diagramm = chartObj.Chart
|
|
|
|
|
|
' Vorhandene Datenreihen löschen
|
|
|
Do While diagramm.SeriesCollection.Count > 0
|
|
|
diagramm.SeriesCollection(1).Delete
|
|
|
Loop
|
|
|
|
|
|
startZeile = 3
|
|
|
Set ws = ThisWorkbook.Worksheets(messungNr)
|
|
|
|
|
|
letzteZeile = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
|
|
|
If letzteZeile >= startZeile Then
|
|
|
For posIndex = 1 To blockAnzahl
|
|
|
startSpalte = (posIndex - 1) * 3 + 1
|
|
|
Set datenBereichX = ws.Range(ws.Cells(startZeile, startSpalte), ws.Cells(letzteZeile, startSpalte))
|
|
|
Set datenBereichY2 = ws.Range(ws.Cells(startZeile, startSpalte + 2), ws.Cells(letzteZeile, startSpalte + 2))
|
|
|
|
|
|
Set datenReihe = diagramm.SeriesCollection.NewSeries
|
|
|
datenReihe.Values = datenBereichY2
|
|
|
datenReihe.XValues = datenBereichX
|
|
|
datenReihe.Name = "Position " & posIndex
|
|
|
datenReihe.Smooth = False
|
|
|
Next posIndex
|
|
|
End If
|
|
|
End Sub
|
|
|
|
|
|
' =========================================
|
|
|
' 7) Diagramme für die HF-Messung
|
|
|
' =========================================
|
|
|
Sub AktualisiereXYDiagrammHF()
|
|
|
Dim datenWs As Worksheet
|
|
|
Dim diagrammWs As Worksheet
|
|
|
Dim chartObj As ChartObject
|
|
|
Dim diagramm As Chart
|
|
|
Dim xRange As Range
|
|
|
Dim yRange As Range
|
|
|
Dim letzteSpalte As Long
|
|
|
Dim letzteZeile As Long
|
|
|
Dim dataIndex As Long
|
|
|
Dim chartIndex As Long
|
|
|
Dim i As Long
|
|
|
Dim s As Series
|
|
|
|
|
|
Application.ScreenUpdating = False
|
|
|
Application.EnableEvents = False
|
|
|
|
|
|
' Für Paare 2->18, 3->19...17->33
|
|
|
For dataIndex = 2 To 17
|
|
|
|
|
|
chartIndex = dataIndex + 16
|
|
|
|
|
|
Set datenWs = ThisWorkbook.Worksheets(dataIndex)
|
|
|
Set diagrammWs = ThisWorkbook.Worksheets(chartIndex)
|
|
|
Set chartObj = diagrammWs.ChartObjects(1)
|
|
|
Set diagramm = chartObj.Chart
|
|
|
|
|
|
letzteZeile = datenWs.Cells(datenWs.Rows.Count, 1).End(xlUp).Row
|
|
|
letzteSpalte = datenWs.Cells(2, datenWs.Columns.Count).End(xlToLeft).Column
|
|
|
|
|
|
Set xRange = datenWs.Range(datenWs.Cells(3, 1), datenWs.Cells(letzteZeile, 1))
|
|
|
|
|
|
Do While diagramm.SeriesCollection.Count > 0
|
|
|
diagramm.SeriesCollection(1).Delete
|
|
|
Loop
|
|
|
|
|
|
For i = 2 To letzteSpalte
|
|
|
Set yRange = datenWs.Range(datenWs.Cells(3, i), datenWs.Cells(letzteZeile, i))
|
|
|
With diagramm.SeriesCollection.NewSeries
|
|
|
.Name = datenWs.Cells(2, i).Value
|
|
|
.XValues = xRange
|
|
|
.Values = yRange
|
|
|
.Smooth = False
|
|
|
.ChartType = xlXYScatterLines
|
|
|
|
|
|
' --- Nur Linie, keine Punkte ---
|
|
|
.MarkerStyle = xlMarkerStyleNone
|
|
|
End With
|
|
|
Next i
|
|
|
|
|
|
' ---- Farben der ersten 3 Serien fest zuweisen ----
|
|
|
If diagramm.SeriesCollection.Count >= 1 Then diagramm.SeriesCollection(1).Format.Line.ForeColor.RGB = RGB(255, 128, 64)
|
|
|
If diagramm.SeriesCollection.Count >= 2 Then diagramm.SeriesCollection(2).Format.Line.ForeColor.RGB = RGB(255, 0, 0)
|
|
|
If diagramm.SeriesCollection.Count >= 3 Then diagramm.SeriesCollection(3).Format.Line.ForeColor.RGB = RGB(0, 128, 189)
|
|
|
|
|
|
' ---- Legende nur ausblenden, wenn:
|
|
|
' Datensatz 1 leer, Datensatz 2 leer, Datensatz 3 hat Werte ----
|
|
|
Dim hat1 As Boolean, hat2 As Boolean, hat3 As Boolean
|
|
|
|
|
|
hat1 = WorksheetFunction.CountA(datenWs.Range(datenWs.Cells(3, 2), datenWs.Cells(letzteZeile, 2))) > 0 ' Spalte B
|
|
|
hat2 = WorksheetFunction.CountA(datenWs.Range(datenWs.Cells(3, 3), datenWs.Cells(letzteZeile, 3))) > 0 ' Spalte C
|
|
|
hat3 = WorksheetFunction.CountA(datenWs.Range(datenWs.Cells(3, 4), datenWs.Cells(letzteZeile, 4))) > 0 ' Spalte D
|
|
|
|
|
|
If (Not hat1) And (Not hat2) And hat3 Then
|
|
|
diagramm.HasLegend = False
|
|
|
Else
|
|
|
diagramm.HasLegend = True
|
|
|
End If
|
|
|
|
|
|
Next dataIndex
|
|
|
|
|
|
Application.EnableEvents = True
|
|
|
Application.ScreenUpdating = True
|
|
|
End Sub
|
