Option Explicit


Dim wsi As Worksheet ' Das Import-Arbeitsblatt
Dim wse As Worksheet ' Das Einstellungs-Arbeitsblatt
Dim wss As Worksheet ' Das Arbeitsblatt für die Spannungen

Sub Button1_click()
' Wird aufgerufen durch Arbeitsblatt [Start] Schaltfläche [Importiere3]
'
Dim txDso As String
Dim wbcsv As Workbook
Dim I As Integer
Dim Zb As Double
Dim Yb As Double
Dim YO As Integer
Dim zbe As String
Dim FK As Double


Debug.Print Date$; " "; Time$; " Import start"

Call LoescheTabellen

' Dateiname der zu importierenden Datei
txDso = ThisWorkbook.Worksheets("Start").Cells(3, 2).Value


wsi.Activate ' Aktiviere das Arbeitsblatt [Importblatt]

With Workbooks.Open(txDso) ' Das liest die gesamte CSV-Datei in ein neues Excel Arbeitsbuch
    .Worksheets(1).UsedRange.Copy Destination:=wsi.Cells(1) ' Das kopiert die DSO-Daten komplett in das Importblatt wsi
    .Close SaveChanges:=False ' Das schließt das Arbeitsbuch A.dso
End With

wsi.Cells(22444, 2).Value = "Zeitbasis [s/div]"
wsi.Cells(22445, 2).Value = "Y1 [V/div]"
wsi.Cells(22446, 2).Value = "Y2 [V/div]"

' Alle Zeiten ausrechnen
Zb = wsi.Cells(22444, 1).Value
zbe = "s"
If Zb < 0.1 Then
    Zb = Zb * 1000
    zbe = "ms"
    If Zb < 0.1 Then
        Zb = Zb * 1000
        zbe = "µs"
    End If
End If
wse.Cells(2, 1).Value = "Zeitbasis[" & zbe & "]"
wse.Cells(2, 2).Value = Zb

Rem bei 5ms/div war / 1250 richtig
FK = 1000
If Zb = 5 Or Zb = 50 Or Zb = 0.5 Then FK = 1250
wse.Cells(2, 3).Value = FK

wss.Cells(1, 1).Value = "Zeit[" & zbe & "]"
For I = 1 To 10100
    wss.Cells(I + 1, 1).Value = Zb * (I - 1) / FK
Next I

' Alle Y1-Werte Umkopieren
If wsi.Cells(22427, 1) = 1 Or wsi.Cells(22427, 1) = 3 Then
    Yb = wsi.Cells(22445, 1).Value
    wse.Cells(3, 1).Value = "Y1[V/div]"
    wse.Cells(3, 2).Value = Yb
    wss.Cells(1, 2).Value = "Y1[V]"
    YO = 256 - wsi.Cells(22430, 1).Value
    
    For I = 1 To 10100
        wss.Cells(I + 1, 2).Value = Yb * (wsi.Cells(I, 1).Value - YO) / 32#
    Next I

End If


' Alle Y2-Werte Umkopieren
If wsi.Cells(22427, 1) = 2 Or wsi.Cells(22427, 1) = 3 Then
    Yb = wsi.Cells(22446, 1).Value
    wse.Cells(4, 1).Value = "Y2[V/div]"
    wse.Cells(4, 2).Value = Yb
    wss.Cells(1, 3).Value = "Y2[V]"
    YO = 256 - wsi.Cells(22431, 1).Value
    
    For I = 1 To 10100
        wss.Cells(I + 1, 3).Value = Yb * (wsi.Cells(I + 10100, 1).Value - YO) / 32#
    Next I

End If
wss.Activate
Debug.Print Date$; " "; Time$; " Import fertig"

End Sub




Sub LoescheTabellen()

Call SetzeTabellennamen
' Lösche die alten Daten im Arbeitsblatt [Importblatt]
Call wsi.Range(wsi.Cells(1, 1), wsi.Cells(wsi.Rows.Count, wsi.Columns.Count)).Clear

' Lösche die alten Daten im Arbeitsblatt [DSOEinstellungen]
Call wse.Range(wse.Cells(1, 1), wse.Cells(wse.Rows.Count, wse.Columns.Count)).Clear

' Lösche die alten Daten im Arbeitsblatt [Spannungen]
Rem Call wss.Range(wss.Cells(1, 1), wss.Cells(wss.Rows.Count, wss.Columns.Count)).Clear
Call wss.Range(wss.Cells(1, 1), wss.Cells(10101, 3)).Clear

End Sub

Sub SetzeTabellennamen()
Set wsi = ThisWorkbook.Worksheets("Importblatt")
Set wse = ThisWorkbook.Worksheets("DSOEinstellungen")
Set wss = ThisWorkbook.Worksheets("Spannungen")

End Sub


Sub Workbook_Open()

ThisWorkbook.Worksheets("Start").Activate ' Das Arbeitsblatt mit dem Namen "Start" aktivieren.
Call ThisWorkbook.Worksheets("Start").Cells(1, 1).Activate


End Sub




Sub Button_Darstellen()
' Rechne die erfassten Spannungen in Darstellungswerte um.
' Siehe hierzu: file:///D:/h/home/html/hjh/cc/deutsch/ts/stmesreg/kalib.xls

Dim w1tx As String
Dim y1n As Double
Dim y1f As Double
Dim w2tx As String
Dim y2n As Double
Dim y2f As Double
Dim r As Range ' Da sind die Parameter
Dim I As Integer

Application.ScreenUpdating = False
Call SetzeTabellennamen

' Der Bereich der parameter muss angepasst werden, nachdem Spalten eingefuegt wurden.

Set r = wss.Range(wss.Cells(4, 18), wss.Cells(9, 18))
w1tx = r.Cells(1).Value
y1n = r.Cells(2).Value
y1f = r.Cells(3).Value
w2tx = r.Cells(4).Value
y2n = r.Cells(5).Value
y2f = r.Cells(6).Value

wss.Cells(1, 4).Value = w1tx
wss.Cells(1, 5).Value = w2tx

For I = 1 To 10100
    wss.Cells(I + 1, 4).Value = (wss.Cells(I + 1, 2).Value + y1n) * y1f
    wss.Cells(I + 1, 5).Value = (wss.Cells(I + 1, 3).Value + y2n) * y2f
Next I
Application.ScreenUpdating = True

End Sub

Sub Button_Wechsel()
' Suche in Y1 nach Wechsel von unter F2, nach über F3, aber nicht schneller als F4
Dim pu As Double
Dim po As Double
Dim zf As Double    ' Zeitfenster
Dim zs As Double    ' Start-Zeitpunkt der Analyse
Dim Zb As Double
Dim r As Range ' Da sind die Parameter
Dim I As Integer
Dim J As Integer
Dim isp As Integer
Dim izl As Integer
Dim w As Double
Dim FK As Double


Dim bK As Boolean   '' Kennung: Wert ist oberhalb

Call SetzeTabellennamen

Application.ScreenUpdating = False

' Hole die Parameter
isp = 18    ' Spalte
izl = 12    ' Zeile
Set r = wss.Range(wss.Cells(izl, isp), wss.Cells(izl + 3, isp))
pu = r.Cells(1).Value
po = r.Cells(2).Value
zf = r.Cells(3).Value
zs = r.Cells(4).Value

For I = 1 To 4
    r.Cells(I).Interior.Color = RGB(255, 255, 255)
Next I

Zb = wse.Cells(2, 2).Value  ' Zeitbasis aus dem Arbeitsblatt "Einstellungen"

' So wurde die Zeit der Zeile I berechnet
'     wss.Cells(I + 1, 1).Value = Zb * (I - 1) / 1250
'     zs = Zb * (I - 1) / 1250
' Also ist:   zs / Zb * 1250 = I-1
FK = wse.Cells(2, 3).Value
I = zs / Zb * FK + 2
If I < 1 Then r.Cells(4).Interior.Color = RGB(255, 128, 128):   Exit Sub
If I > 10100 Then r.Cells(4).Interior.Color = RGB(255, 128, 128):   Exit Sub



w = wss.Cells(I, 4)
bK = False
If w > po Then bK = True
J = 2
Do While I < 10100
    w = wss.Cells(I, 4).Value
    If bK Then
        If w < pu Then
            bK = False
            wss.Cells(izl, J + isp).Value = I
            wss.Cells(izl + 2, J + isp).Value = wss.Cells(I, 1).Value
        End If
    Else
        If w > po Then
            bK = True
            wss.Cells(izl + 1, J + isp).Value = I
            wss.Cells(izl + 3, J + isp).Value = wss.Cells(I, 1).Value
            J = J + 1
            If J > 20 Then Exit Do
        End If
    End If
    I = I + 1
Loop

Application.ScreenUpdating = True

End Sub

Sub Button_Uebernahme_Wechselstrom()

Dim IStart As Integer
Dim IEnde As Integer
Dim wsw As Worksheet
Dim isp As Integer
Dim izl As Integer

Call SetzeTabellennamen

Application.ScreenUpdating = False

' Hole die Parameter
isp = 18    ' Spalte
izl = 21    ' Zeile
IStart = wss.Cells(izl, isp).Value
IEnde = wss.Cells(izl + 1, isp).Value

If IStart < 2 Then wss.Cells(izl, isp).Interior.Color = RGB(255, 128, 128): Exit Sub
If IStart > 10100 Then wss.Cells(izl, isp).Interior.Color = RGB(255, 128, 128): Exit Sub

If IEnde < 2 Then wss.Cells(izl + 1, isp).Interior.Color = RGB(255, 128, 128): Exit Sub
If IEnde > 10100 Then wss.Cells(izl + 1, isp).Interior.Color = RGB(255, 128, 128): Exit Sub

wss.Cells(izl, isp).Interior.Color = RGB(255, 255, 255)
wss.Cells(izl + 1, isp).Interior.Color = RGB(255, 255, 255)

Set wsw = ThisWorkbook.Worksheets("Wechselstrom")

Call wsw.Range(wsw.Cells(1, 1), wsw.Cells(10101, 5)).Clear
' Kopfzeilen kopieren
For isp = 1 To 5
    wsw.Cells(1, isp) = wss.Cells(1, isp)
Next isp

Call wss.Range(wss.Cells(IStart, 1), wss.Cells(IEnde, 5)).Copy(wsw.Cells(2, 1))

End Sub
