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.
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!!!!