hexagon logo

pcdlrn.tlb Excel problem

Hallo,

It's the first time for me in this Forum.
I hope you can help me.

I try to read out data from PCDMIS but i get no data. Disappointed

thats the code



    'Konstante Deklarieren
    Const intColumDimName As Integer = 1        'Spalte 1 (A) für Messpunktname
    Const intColumDimMeasured As Integer = 2    'Spalte 2 (B) für Messwerte
    
    Dim strAchse As String                      ' Variable für Achsbezeichnung
    
Sub Daten_auslesen()

    Call fkt_DatenfelderLesen

    'Dateiname Festlegen & Speichern
        Dim strDateiName As String                  'Dateiname
        Dim strDateiPfad As String                  'Dateipfad
    'strDateiName = Format(Date(), "ddmmyy") &  "_ABF_" & cbo_Karitaet.value
    'strDateiPfad = "d:\Messwerte\Audit\DC\"
    'ActiveWorkbook.SaveAs Filename:=strDateiPfad & strDateiName
End Sub

Private Sub fkt_DatenfelderLesen()

    'Variablen aus Messprogramm
        Dim app As PCDLRN.Application
        Dim pp As PCDLRN.PartProgram
        Dim cmd As PCDLRN.Command
        Dim cmds As PCDLRN.Commands
        Dim dimen As PCDLRN.DimensionCmd
    'Variablen
        Dim I As Integer                            'Algemeine Variable für Zeile
        Dim strID As String
        Dim strAktBlattName As String               'String für Blattname
        Dim AktBlatt As Worksheet                   ' Selbsterklärend
    'Variablen füllen
        Set app = CreateObject("PCDLRN.Application")    'Setzt Messprogramm als Quelle für PCDLRN Variablen
        Set pp = app.ActivePartProgram                  'Setzt Aktive Instanz vom Messprogramm als Quelle
        Set cmds = pp.Commands                          ' Commands ist die Variable aus Messprogramm
    'Blatt erstellen und wählen
        Set AktBlatt = Worksheets(1)                    'Blatt Aktivieren
        strAktBlattName = "Werte aus Messung"           'Blattname vergeben
        AktBlatt.Name = strAktBlattName                 'Selbsterklärend ;-)
    'Formatierung Aufrufen
        fkt_Formatierung
    ' Messpunktname schreiben
        I = 4
        For Each cmd In cmds
            If cmd.IsDimension Then
                If strID <> cmd.ID Then
                    Set dimen = cmd.DimensionCommand
                        ActiveSheet.Cells(I + 1, intColumDimName).Select
                        ActiveSheet.Cells(I + 1, intColumDimName).Activate
                        ActiveSheet.Cells(I + 1, intColumDimName) = cmdID + " = " + cmd.TypeDescription + " von " + dimen.feat1
                        I = I + 1
                End If
                strID = cmd.ID
                strAchse = ""
                Select Case cmd.Type
                    Case DIMENSION_START_LOCATION, DIMENSION_TRUE_START_POSITION
                    Case DIMENSION_TRUE_X_LOCATION, DIMENSION_TRUE_Y_LOCATION, DIMENSION_TRUE_Z_LOCATION
                        Set dimen = cmd.DimensionCommand
                            ActiveSheet.Cells(I + 1, intColumMeasured) = dimen.Measured
                        I = I + 1
                Case Else
                    Set dimen = cmd.DimensionCommand
                    ActiveSheet.Cells(I + 1, intColumMeasured) = dimen.Measured
                    I = I + 1
                End Select
            End If
        Next cmd
End Sub

Private Sub fkt_Formatierung()
    'kopfdaten füllen
        ActiveSheet.Cells(1, intColumDimName) = "Datum"
        ActiveSheet.Cells(1, intColumMeasured) = Format(Date, "dd.mm.yyyy")
        ActiveSheet.Cells(2, intColumDimName) = "Uhrzeit"
        ActiveSheet.Cells(2, intColumMeasured) = "'" & Format(Time, "hh:mm:ss")
        ActiveSheet.Cells(4, intColumDimName) = "ABM-Name"
        ActiveSheet.Cells(4, intColumMeasured) = "Messwert"
    'Rahmen zeichnen
        Rows(2).Select
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
        Rows(3).Select
            ActiveWindow.FreezePanes = True
        Columns("A:XX").Select
            Selection.NumberFormat = "0.000"        ' Format für Zahlen = 3 Nachkommastellen
        Range("d1:d2").Select
            With Selection
                .HorizontalAlignment = xlCenter     ' Datum und Uhrzeit zentriert
            End With
        Range("a1: a1").Select
End Sub



thank you!!!!