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!!!!
Parents
  • I have no real idea what may be wrong. It seems functional to me.

    Have you tried to simplify your program? Were you able to get any results into the Script? Maybe first try to write them to a simple text file?

    In other words, does dimen.Measured return anything????

    I guess I would chop up the program to the smallest piece where you know that the result that comes back is correct. then expand until it all works again.


    My 2 cents, Jan.
Reply
  • I have no real idea what may be wrong. It seems functional to me.

    Have you tried to simplify your program? Were you able to get any results into the Script? Maybe first try to write them to a simple text file?

    In other words, does dimen.Measured return anything????

    I guess I would chop up the program to the smallest piece where you know that the result that comes back is correct. then expand until it all works again.


    My 2 cents, Jan.
Children
No Data