##// END OF EJS Templates
Projects » PositioningSystem
RSS
- Bugs corrected: resistance measurement mOhm instead of uOhm, limitation for Z- ans stroke for negative Z
- Bugs corrected: resistance measurement mOhm instead of uOhm, limitation for Z- ans stroke for negative Z
LabVIEW - - Load All Authors

File last commit:

r12:13
r17:18
Show More
Macro.bas
217 lines | 9.2 KiB | text/x-vbnet | VbNetLexer
/ support / ReportTemplates / Macro.bas
History | Source | Raw |Copy content |Copy permalink
LabVIEW
- Increment standard measurement: Excel protocol added
 r12 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
End With
Next i
End Sub
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
End With
Next i
End Sub
Sub AktualisiereXYDiagrammInkrementWiderstand()
Dim wsAktuell As Worksheet
Dim ws As Worksheet
Dim chartObj As ChartObject
Dim diagramm As Chart
Dim letzteZeile As Long
Dim letzteSpalte As Long
Dim datenBereichX As Range
Dim datenBereichY1 As Range
Dim datenReihe As Series
Dim diagrammTitel As String
Dim startZeile As Long
Dim blockAnzahl As Long
Dim blockStartSpalte As Long
Dim blockEndSpalte As Long
Dim blockIndex As Integer
' Arbeitsblatt "Widerstandsdiagramm" festlegen
Set wsAktuell = ThisWorkbook.Worksheets("Widerstandsdiagramm")
' Diagramm auf "Widerstandsdiagramm" suchen
If wsAktuell.ChartObjects.Count = 0 Then
MsgBox "Kein Diagramm auf 'Widerstandsdiagramm' gefunden.", vbExclamation
Exit Sub
End If
Set chartObj = wsAktuell.ChartObjects(1)
Set diagramm = chartObj.Chart
' Vorhandene Datenreihen löschen
Do While diagramm.SeriesCollection.Count > 0
diagramm.SeriesCollection(1).Delete
Loop
' Alle Blätter vor "Widerstandsdiagramm" durchlaufen
For Each ws In ThisWorkbook.Worksheets
If ws.Index < wsAktuell.Index Then
' Letzte Zeile im Blatt ermitteln
letzteZeile = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
' Prüfen, ob relevante Daten vorhanden sind
If letzteZeile >= 3 Then
' Startzeile und Anzahl der Datenblöcke definieren
startZeile = 3
blockStartSpalte = 1 ' Erste Spalte für x
blockEndSpalte = 3 ' Spalten x, y1, y2
blockAnzahl = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column / 3 ' Anzahl Blöcke
' Datenblöcke durchlaufen
For blockIndex = 0 To blockAnzahl - 1
' X-Werte und Y1-Werte für den aktuellen Block definieren
With ws
Set datenBereichX = .Range(.Cells(startZeile, blockStartSpalte + blockIndex * 3), _
.Cells(letzteZeile, blockStartSpalte + blockIndex * 3)) ' Spalte X
Set datenBereichY1 = .Range(.Cells(startZeile, blockStartSpalte + blockIndex * 3 + 1), _
.Cells(letzteZeile, blockStartSpalte + blockIndex * 3 + 1)) ' Spalte Y1
' Neue Datenreihe hinzufügen
Set datenReihe = diagramm.SeriesCollection.NewSeries
datenReihe.Values = datenBereichY1
datenReihe.XValues = datenBereichX
datenReihe.Name = ws.Name & " - Position " & (blockIndex + 1)
End With
Next blockIndex
End If
End If
Next ws
End Sub
Sub AktualisiereXYDiagrammInkrementKraft()
Dim wsWiderstand As Worksheet
Dim wsKraft As Worksheet
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 diagrammTitel As String
Dim startZeile As Long
Dim blockAnzahl As Long
Dim blockStartSpalte As Long
Dim blockEndSpalte As Long
Dim blockIndex As Integer
' Arbeitsblätter "Widerstandsdiagramm" und "Kraftdiagramm" festlegen
Set wsWiderstand = ThisWorkbook.Worksheets("Widerstandsdiagramm")
Set wsKraft = ThisWorkbook.Worksheets("Kraftdiagramm")
' Diagramm auf "Kraftdiagramm" suchen
If wsKraft.ChartObjects.Count = 0 Then
MsgBox "Kein Diagramm auf 'Kraftdiagramm' gefunden.", vbExclamation
Exit Sub
End If
Set chartObj = wsKraft.ChartObjects(1)
Set diagramm = chartObj.Chart
' Vorhandene Datenreihen löschen
Do While diagramm.SeriesCollection.Count > 0
diagramm.SeriesCollection(1).Delete
Loop
' Alle Blätter vor "Widerstandsdiagramm" durchlaufen
For Each ws In ThisWorkbook.Worksheets
If ws.Index < wsWiderstand.Index Then
' Letzte Zeile im Blatt ermitteln
letzteZeile = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
' Prüfen, ob relevante Daten vorhanden sind
If letzteZeile >= 3 Then
' Startzeile und Anzahl der Datenblöcke definieren
startZeile = 3
blockStartSpalte = 1 ' Erste Spalte für x
blockEndSpalte = 3 ' Spalten x, y1, y2
blockAnzahl = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column / 3 ' Anzahl Blöcke
' Datenblöcke durchlaufen
For blockIndex = 0 To blockAnzahl - 1
' X-Werte und Y2-Werte für den aktuellen Block definieren
With ws
Set datenBereichX = .Range(.Cells(startZeile, blockStartSpalte + blockIndex * 3), _
.Cells(letzteZeile, blockStartSpalte + blockIndex * 3)) ' Spalte X
Set datenBereichY2 = .Range(.Cells(startZeile, blockStartSpalte + blockIndex * 3 + 2), _
.Cells(letzteZeile, blockStartSpalte + blockIndex * 3 + 2)) ' Spalte Y2
' Neue Datenreihe hinzufügen
Set datenReihe = diagramm.SeriesCollection.NewSeries
datenReihe.Values = datenBereichY2
datenReihe.XValues = datenBereichX
datenReihe.Name = ws.Name & " - Position " & (blockIndex + 1)
End With
Next blockIndex
End If
End If
Next ws
End Sub