Help with basic scripts export excel

1.Purpose：Export original excel data from PC-DMIS, and then use vlookup to get data for Excel report；
2.Problem：IF true position is existed,other Axis deviation needs to be removed;

Public Function GetAxis(t As OBTYPE) As String
Dim s As String
Select Case t
Case DIMENSION_D_LOCATION: s = "D"
Case DIMENSION_A_LOCATION: s = "A"
Case DIMENSION_H_LOCATION: s = "H"
Case DIMENSION_L_LOCATION: s = "L"
Case DIMENSION_PA_LOCATION: s = "PA"
Case DIMENSION_PD_LOCATION: s = "PD"
Case DIMENSION_PR_LOCATION: s = "PR"
Case DIMENSION_R_LOCATION: s = "R"
Case DIMENSION_RS_LOCATION: s = "RS"
Case DIMENSION_RT_LOCATION: s = "RT"
Case DIMENSION_S_LOCATION: s = "S"
Case DIMENSION_T_LOCATION: s = "T"
Case DIMENSION_V_LOCATION: s = "V"
Case DIMENSION_X_LOCATION: s = "X"
Case DIMENSION_Y_LOCATION: s = "Y"
Case DIMENSION_Z_LOCATION: s = "Z"
Case DIMENSION_TRUE_DD_LOCATION: s = "DD"
Case DIMENSION_TRUE_DF_LOCATION: s = "DF"
Case DIMENSION_TRUE_DIAM_LOCATION: s = "TP"
Case DIMENSION_TRUE_D1_LOCATION: s = "D1"
Case DIMENSION_TRUE_D2_LOCATION: s = "D2"
Case DIMENSION_TRUE_D3_LOCATION: s = "D3"
Case DIMENSION_TRUE_PA_LOCATION: s = "PA"
Case DIMENSION_TRUE_PR_LOCATION: s = "PR"
Case DIMENSION_TRUE_X_LOCATION: s = "X"
Case DIMENSION_TRUE_Y_LOCATION: s = "Y"
Case DIMENSION_TRUE_Z_LOCATION: s = "Z"
Case Else: s = "M"
End Select
GetAxis = s
End Function
Sub Main()
Dim App As Object
Set App = CreateObject("PCDLRN.Application")
Dim Part As Object
Set Part = App.ActivePartProgram
Dim Cmds As Object
Set Cmds = Part.Commands
Dim Cmd As Command
Dim exlapp As Object
Dim wbook As Object
Dim sht As Object
Dim str
i = 2
Set exlapp = CreateObject("excel.application")
Set wbook = exlapp.Workbooks.Add
Set sht = wbook.Sheets(1)
sht.Range("A"&1)="ID":sht.Range("B"&1)="Nominal":s ht.Range("C"&1)="+Tol"
sht.Range("D"&1)="-Tol":sht.Range("E"&1)="Measured":sht.Range("F"&1)= "Dev":sht.Range("G"&1)="Out"
For Each Cmd In Cmds
If Cmd.IsDimension Then
If Cmd.ID <> "" Then str = Cmd.ID
Select Case Cmd.Type
Case 1002, 1003, 1004, 1005, 1006, 1007, 1008, 1009, 1010, 1011, 1012, 1013, 1014, 1015, 1016, 1017
sht.Range("A" & i) = str & "-" & GetAxis(Cmd.Type)
sht.Range("B" & i) = Cmd.GetText(NOMINAL, 0)
sht.Range("C" & i) = Cmd.GetText(F_PLUS_TOL, 0)
sht.Range("D" & i) = Cmd.GetText(F_MINUS_TOL, 0)
sht.Range("E" & i) = Cmd.GetText(DIM_MEASURED, 0)
sht.Range("F" & i) = Cmd.GetText(DIM_DEVIATION, 0)
sht.Range("G" & i) = Cmd.GetText(DIM_OUTTOL, 0)
i = i + 1
Case 1202, 1203, 1204, 1205, 1206, 1207, 1208,1214,1215,1216
sht.Range("A" & i) = str & "-" & GetAxis(Cmd.Type)
sht.Range("B" & i) = Cmd.GetText(NOMINAL, 0)
sht.Range("C" & i) = Cmd.GetText(F_PLUS_TOL, 0)
sht.Range("D" & i) = Cmd.GetText(F_MINUS_TOL, 0)
sht.Range("E" & i) = Cmd.GetText(DIM_MEASURED, 0)
sht.Range("F" & i) = Cmd.GetText(DIM_DEVIATION, 0)
sht.Range("G" & i) = Cmd.GetText(DIM_OUTTOL, 0)
i = i + 1
Case 1209
sht.Range("A" & i) = str & "-" & GetAxis(Cmd.Type)
sht.Range("B" & i) = 0
sht.Range("C" & i) = Cmd.GetText(F_PLUS_TOL, 0)
sht.Range("D" & i) = 0
sht.Range("E" & i) = Cmd.GetText(DIM_DEVIATION, 0)
sht.Range("F" & i) = Cmd.GetText(DIM_DEVIATION, 0)
sht.Range("G" & i) = Cmd.GetText(DIM_OUTTOL, 0)
i = i + 1
Case 1100, 1101, 1102, 1103, 1104, 1105, 1106, 1107, 1108, 1109, 1110, 1111, 1112, 1113, 1114, 1115, 1116, 1117, 1118
sht.Range("A" & i) = str & "-" & GetAxis(Cmd.Type)
sht.Range("B" & i) = Cmd.GetText(NOMINAL, 0)
If sht.Range("B" & i) = "" Then sht.Range("B" & i)=0
sht.Range("C" & i) = Cmd.GetText(F_PLUS_TOL, 0)
sht.Range("D" & i) = Cmd.GetText(F_MINUS_TOL, 0)
If sht.Range("D" & i) = "" Then sht.Range("D" & i)=0
sht.Range("E" & i) = Cmd.GetText(DIM_MEASURED, 0)
sht.Range("F" & i) = Cmd.GetText(DIM_DEVIATION, 0)
sht.Range("G" & i) = Cmd.GetText(DIM_OUTTOL, 0)
i = i + 1
End Select
End If
Next
exlapp.Visible = True
exlapp.DisplayAlerts = False
Set exlapp = Nothing
Set wbook = Nothing
Set sht = Nothing
End Sub

Parents

rowphy over 4 years ago

It can not work properly when I add these code.
Tips:Syntax Error on line:108-_Next

Public Function GetAxis(t As OBTYPE) As String
Dim s As String
Select Case t
Case DIMENSION_D_LOCATION: s = "D"
Case DIMENSION_A_LOCATION: s = "A"
Case DIMENSION_H_LOCATION: s = "H"
Case DIMENSION_L_LOCATION: s = "L"
Case DIMENSION_PA_LOCATION: s = "PA"
Case DIMENSION_PD_LOCATION: s = "PD"
Case DIMENSION_PR_LOCATION: s = "PR"
Case DIMENSION_R_LOCATION: s = "R"
Case DIMENSION_RS_LOCATION: s = "RS"
Case DIMENSION_RT_LOCATION: s = "RT"
Case DIMENSION_S_LOCATION: s = "S"
Case DIMENSION_T_LOCATION: s = "T"
Case DIMENSION_V_LOCATION: s = "V"
Case DIMENSION_X_LOCATION: s = "X"
Case DIMENSION_Y_LOCATION: s = "Y"
Case DIMENSION_Z_LOCATION: s = "Z"
Case DIMENSION_TRUE_DD_LOCATION: s = "DD"
Case DIMENSION_TRUE_DF_LOCATION: s = "DF"
Case DIMENSION_TRUE_DIAM_LOCATION: s = "TP"
Case DIMENSION_TRUE_D1_LOCATION: s = "D1"
Case DIMENSION_TRUE_D2_LOCATION: s = "D2"
Case DIMENSION_TRUE_D3_LOCATION: s = "D3"
Case DIMENSION_TRUE_PA_LOCATION: s = "PA"
Case DIMENSION_TRUE_PR_LOCATION: s = "PR"
Case DIMENSION_TRUE_X_LOCATION: s = "X"
Case DIMENSION_TRUE_Y_LOCATION: s = "Y"
Case DIMENSION_TRUE_Z_LOCATION: s = "Z"
Case Else: s = "M"
End Select
GetAxis = s
End Function
Sub Main()
Dim App As Object
Set App = CreateObject("PCDLRN.Application")
Dim Part As Object
Set Part = App.ActivePartProgram
Dim Cmds As Object
Set Cmds = Part.Commands
Dim Cmd As Command
Dim exlapp As Object
Dim wbook As Object
Dim sht As Object
Dim str
i = 2
Set exlapp = CreateObject("excel.application")
Set wbook = exlapp.Workbooks.Add
Set sht = wbook.Sheets(1)
sht.Range("A"&1)="ID":sht.Range("B"&1)="Nominal":s ht.Range("C"&1)="+Tol"
sht.Range("D"&1)="-Tol":sht.Range("E"&1)="Measured":sht.Range("F"&1)= "Dev":sht.Range("G"&1)="Out"


For Each Cmd In Cmds
[COLOR=#c0392b]If Cmd.Type = DIMENSION_START_TRUE_POSITION And Cmd.DimensionCommand.AxisLetter = "TP" Then           ‘add code[/COLOR]
If Cmd.IsDimension Then
If Cmd.ID <> "" Then str = Cmd.ID
Select Case Cmd.Type
Case 1002, 1003, 1004, 1005, 1006, 1007, 1008, 1009, 1010, 1011, 1012, 1013, 1014, 1015, 1016, 1017
sht.Range("A" & i) = str & "-" & GetAxis(Cmd.Type)
sht.Range("B" & i) = Cmd.GetText(NOMINAL, 0)
sht.Range("C" & i) = Cmd.GetText(F_PLUS_TOL, 0)
sht.Range("D" & i) = Cmd.GetText(F_MINUS_TOL, 0)
sht.Range("E" & i) = Cmd.GetText(DIM_MEASURED, 0)
sht.Range("F" & i) = Cmd.GetText(DIM_DEVIATION, 0)
sht.Range("G" & i) = Cmd.GetText(DIM_OUTTOL, 0)
sht.Range("H" & i) = right(str,(len(str)-3))
sht.Range("I" & i) = GetAxis(Cmd.Type)
i = i + 1
Case 1202, 1203, 1204, 1205, 1206, 1207, 1208,1214,1215,1216
sht.Range("A" & i) = str & "-" & GetAxis(Cmd.Type)
sht.Range("B" & i) = Cmd.GetText(NOMINAL, 0)
sht.Range("C" & i) = Cmd.GetText(F_PLUS_TOL, 0)
sht.Range("D" & i) = Cmd.GetText(F_MINUS_TOL, 0)
sht.Range("E" & i) = Cmd.GetText(DIM_MEASURED, 0)
sht.Range("F" & i) = Cmd.GetText(DIM_DEVIATION, 0)
sht.Range("G" & i) = Cmd.GetText(DIM_OUTTOL, 0)
sht.Range("H" & i) = right(str,(len(str)-3))
sht.Range("I" & i) = GetAxis(Cmd.Type)
i = i + 1
Case 1209
sht.Range("A" & i) = str & "-" & GetAxis(Cmd.Type)
sht.Range("B" & i) = 0
sht.Range("C" & i) = Cmd.GetText(F_PLUS_TOL, 0)
sht.Range("D" & i) = 0
sht.Range("E" & i) = Cmd.GetText(DIM_DEVIATION, 0)
sht.Range("F" & i) = Cmd.GetText(DIM_DEVIATION, 0)
sht.Range("G" & i) = Cmd.GetText(DIM_OUTTOL, 0)
sht.Range("H" & i) = right(str,(len(str)-3))
sht.Range("I" & i) = GetAxis(Cmd.Type)
i = i + 1
Case 1100, 1101, 1102, 1103, 1104, 1105, 1106, 1107, 1108, 1109, 1110, 1111, 1112, 1113, 1114, 1115, 1116, 1117, 1118
sht.Range("A" & i) = str & "-" & GetAxis(Cmd.Type)
sht.Range("B" & i) = Cmd.GetText(NOMINAL, 0)
If sht.Range("B" & i) = "" Then sht.Range("B" & i)=0
sht.Range("C" & i) = Cmd.GetText(F_PLUS_TOL, 0)
sht.Range("D" & i) = Cmd.GetText(F_MINUS_TOL, 0)
If sht.Range("D" & i) = "" Then sht.Range("D" & i)=0
sht.Range("E" & i) = Cmd.GetText(DIM_MEASURED, 0)
sht.Range("F" & i) = Cmd.GetText(DIM_DEVIATION, 0)
sht.Range("G" & i) = Cmd.GetText(DIM_OUTTOL, 0)
sht.Range("H" & i) = right(str,(len(str)-3))
sht.Range("I" & i) = GetAxis(Cmd.Type)
i = i + 1
End Select
End If
[COLOR=#c0392b]Next                                         ‘Error location[/COLOR]

exlapp.Visible = True
exlapp.DisplayAlerts = False
Set exlapp = Nothing
Set wbook = Nothing
Set sht = Nothing
End Sub

Reply

rowphy over 4 years ago

It can not work properly when I add these code.
Tips:Syntax Error on line:108-_Next

Public Function GetAxis(t As OBTYPE) As String
Dim s As String
Select Case t
Case DIMENSION_D_LOCATION: s = "D"
Case DIMENSION_A_LOCATION: s = "A"
Case DIMENSION_H_LOCATION: s = "H"
Case DIMENSION_L_LOCATION: s = "L"
Case DIMENSION_PA_LOCATION: s = "PA"
Case DIMENSION_PD_LOCATION: s = "PD"
Case DIMENSION_PR_LOCATION: s = "PR"
Case DIMENSION_R_LOCATION: s = "R"
Case DIMENSION_RS_LOCATION: s = "RS"
Case DIMENSION_RT_LOCATION: s = "RT"
Case DIMENSION_S_LOCATION: s = "S"
Case DIMENSION_T_LOCATION: s = "T"
Case DIMENSION_V_LOCATION: s = "V"
Case DIMENSION_X_LOCATION: s = "X"
Case DIMENSION_Y_LOCATION: s = "Y"
Case DIMENSION_Z_LOCATION: s = "Z"
Case DIMENSION_TRUE_DD_LOCATION: s = "DD"
Case DIMENSION_TRUE_DF_LOCATION: s = "DF"
Case DIMENSION_TRUE_DIAM_LOCATION: s = "TP"
Case DIMENSION_TRUE_D1_LOCATION: s = "D1"
Case DIMENSION_TRUE_D2_LOCATION: s = "D2"
Case DIMENSION_TRUE_D3_LOCATION: s = "D3"
Case DIMENSION_TRUE_PA_LOCATION: s = "PA"
Case DIMENSION_TRUE_PR_LOCATION: s = "PR"
Case DIMENSION_TRUE_X_LOCATION: s = "X"
Case DIMENSION_TRUE_Y_LOCATION: s = "Y"
Case DIMENSION_TRUE_Z_LOCATION: s = "Z"
Case Else: s = "M"
End Select
GetAxis = s
End Function
Sub Main()
Dim App As Object
Set App = CreateObject("PCDLRN.Application")
Dim Part As Object
Set Part = App.ActivePartProgram
Dim Cmds As Object
Set Cmds = Part.Commands
Dim Cmd As Command
Dim exlapp As Object
Dim wbook As Object
Dim sht As Object
Dim str
i = 2
Set exlapp = CreateObject("excel.application")
Set wbook = exlapp.Workbooks.Add
Set sht = wbook.Sheets(1)
sht.Range("A"&1)="ID":sht.Range("B"&1)="Nominal":s ht.Range("C"&1)="+Tol"
sht.Range("D"&1)="-Tol":sht.Range("E"&1)="Measured":sht.Range("F"&1)= "Dev":sht.Range("G"&1)="Out"


For Each Cmd In Cmds
[COLOR=#c0392b]If Cmd.Type = DIMENSION_START_TRUE_POSITION And Cmd.DimensionCommand.AxisLetter = "TP" Then           ‘add code[/COLOR]
If Cmd.IsDimension Then
If Cmd.ID <> "" Then str = Cmd.ID
Select Case Cmd.Type
Case 1002, 1003, 1004, 1005, 1006, 1007, 1008, 1009, 1010, 1011, 1012, 1013, 1014, 1015, 1016, 1017
sht.Range("A" & i) = str & "-" & GetAxis(Cmd.Type)
sht.Range("B" & i) = Cmd.GetText(NOMINAL, 0)
sht.Range("C" & i) = Cmd.GetText(F_PLUS_TOL, 0)
sht.Range("D" & i) = Cmd.GetText(F_MINUS_TOL, 0)
sht.Range("E" & i) = Cmd.GetText(DIM_MEASURED, 0)
sht.Range("F" & i) = Cmd.GetText(DIM_DEVIATION, 0)
sht.Range("G" & i) = Cmd.GetText(DIM_OUTTOL, 0)
sht.Range("H" & i) = right(str,(len(str)-3))
sht.Range("I" & i) = GetAxis(Cmd.Type)
i = i + 1
Case 1202, 1203, 1204, 1205, 1206, 1207, 1208,1214,1215,1216
sht.Range("A" & i) = str & "-" & GetAxis(Cmd.Type)
sht.Range("B" & i) = Cmd.GetText(NOMINAL, 0)
sht.Range("C" & i) = Cmd.GetText(F_PLUS_TOL, 0)
sht.Range("D" & i) = Cmd.GetText(F_MINUS_TOL, 0)
sht.Range("E" & i) = Cmd.GetText(DIM_MEASURED, 0)
sht.Range("F" & i) = Cmd.GetText(DIM_DEVIATION, 0)
sht.Range("G" & i) = Cmd.GetText(DIM_OUTTOL, 0)
sht.Range("H" & i) = right(str,(len(str)-3))
sht.Range("I" & i) = GetAxis(Cmd.Type)
i = i + 1
Case 1209
sht.Range("A" & i) = str & "-" & GetAxis(Cmd.Type)
sht.Range("B" & i) = 0
sht.Range("C" & i) = Cmd.GetText(F_PLUS_TOL, 0)
sht.Range("D" & i) = 0
sht.Range("E" & i) = Cmd.GetText(DIM_DEVIATION, 0)
sht.Range("F" & i) = Cmd.GetText(DIM_DEVIATION, 0)
sht.Range("G" & i) = Cmd.GetText(DIM_OUTTOL, 0)
sht.Range("H" & i) = right(str,(len(str)-3))
sht.Range("I" & i) = GetAxis(Cmd.Type)
i = i + 1
Case 1100, 1101, 1102, 1103, 1104, 1105, 1106, 1107, 1108, 1109, 1110, 1111, 1112, 1113, 1114, 1115, 1116, 1117, 1118
sht.Range("A" & i) = str & "-" & GetAxis(Cmd.Type)
sht.Range("B" & i) = Cmd.GetText(NOMINAL, 0)
If sht.Range("B" & i) = "" Then sht.Range("B" & i)=0
sht.Range("C" & i) = Cmd.GetText(F_PLUS_TOL, 0)
sht.Range("D" & i) = Cmd.GetText(F_MINUS_TOL, 0)
If sht.Range("D" & i) = "" Then sht.Range("D" & i)=0
sht.Range("E" & i) = Cmd.GetText(DIM_MEASURED, 0)
sht.Range("F" & i) = Cmd.GetText(DIM_DEVIATION, 0)
sht.Range("G" & i) = Cmd.GetText(DIM_OUTTOL, 0)
sht.Range("H" & i) = right(str,(len(str)-3))
sht.Range("I" & i) = GetAxis(Cmd.Type)
i = i + 1
End Select
End If
[COLOR=#c0392b]Next                                         ‘Error location[/COLOR]

exlapp.Visible = True
exlapp.DisplayAlerts = False
Set exlapp = Nothing
Set wbook = Nothing
Set sht = Nothing
End Sub

Children

No Data