VB output to excel

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • VB output to excel

    I have a script that i found on here somewhere that creates excel reports and imports all the data in rows. I would like for the data to be imported in columns. I tried it by changing all the row commands to column and all column commands to row, but with no success. What am i doing wrong?

    Also, what did the Let and Set assignment statements change to or what they have been replaced with?

    Thanks

  • #2
    Are their coordinates? e.g. "place this in cell (3,5)"?

    Maybe try reversing the order (5,3)

    Comment


    • #3
      Unfortunately not.
      This is the code i'm using. I got this from here years ago but never played with it until now.

      Code:
      Sub Main
      
      
      'xl Declarations
      Dim xlApp As Object
      Dim xlWorkbooks As Object
      Dim xlWorkbook As Object
      Dim xlSheet As Object
      Dim count As Integer
      
      
      'pcdlrn declarations And Open ppg
      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 Object
      Dim DCmd As Object
      Dim DcmdID As Object
      Dim DimID As String
      Dim fs As Object
      Dim ReportDim As String
      Dim CheckDim As String
      
      'Check To see If results file exists
      FilePath = "C:\Excel Data\"
      Set fs = CreateObject("Scripting.FileSystemObject") 
      ResFileExists = fs.fileexists(FilePath & Part.partname & ".xls")
      
      
      'Open Excel And Base form
      Set xlApp = CreateObject("Excel.Application")
      Set xlWorkbooks = xlapp.Workbooks
      If ResFileExists = False Then
          TempFilename = FilePath & "Loop Template.xls"
      Else
          TempFilename = FilePath & Part.partname & ".xls"
      End If
      Set xlWorkbook = xlWorkbooks.Open(TempFilename)
      Set xlSheet = xlWorkbook.Worksheets("Sheet1") 
      
      
      If ResFileExists = False Then
          RCount=6
          CCount=3
          xlSheet.Range("B1").Value = Part.PartName
          xlSheet.Range("A6").Value = Date() & " " & Time()
      
          For Each Cmd In Cmds
              'Eliminate DATDEF's
              If Cmd.Type <> 1299 Then
                  'Do Dimensions
                  If Cmd.IsDimension Then
                      If Cmd.Type = DIMENSION_START_LOCATION Or Cmd.Type = DIMENSION_TRUE_START_POSITION Then
                          Set DcmdID = Cmd.DimensionCommand
                            DimID = DcmdID.ID
                            ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                      End If
                      If Cmd.Type <> DIMENSION_START_LOCATION And Cmd.Type <> DIMENSION_END_LOCATION And _
                          Cmd.Type <> DIMENSION_TRUE_START_POSITION And Cmd.Type <> DIMENSION_TRUE_END_POSITION Then
                          Set DCmd = Cmd.DimensionCommand
                          CheckDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                          If CheckDim <> "" Then
                                  ReportDim = CheckDim
                          End If
                          If ReportDim = "BOTH" Or ReportDim = "STATS" Then
                              If DCmd.ID = "" Then
                                      xlSheet.Cells(5,CCount).Value = DimID
                              Else
                                      xlSheet.Cells(5,CCount).Value = DCmd.ID
                              End If
                                      xlSheet.Cells(2,CCount).Value = DCmd.Nominal
                                      xlSheet.Cells(3,CCount).Value = DCmd.Plus
                                      xlSheet.Cells(4,CCount).Value = DCmd.Minus
                                      'Measured Or Deviation With check For True Position+
                            If DCmd.AxisLetter <> "TP" Then
                                        xlSheet.Cells(6,CCount).Value = DCmd.Measured
                      Else
                                        xlSheet.Cells(6,CCount).Value = DCmd.Deviation
                      End If
                                      'Add Min/Max For Profile dimensions
                                      If Cmd.Type = 1118 Or Cmd.Type = 1105 Then
                                        CCount=CCount+1
                                        xlSheet.Cells(5,CCount).Value = DCmd.ID & "." & "Max"
                                        xlSheet.Cells(2,CCount).Value = DCmd.Nominal
                                        xlSheet.Cells(3,CCount).Value = DCmd.Plus
                                        xlSheet.Cells(4,CCount).Value = DCmd.Minus
                                        xlSheet.Cells(6,CCount).Value = DCmd.Max
                                        CCount=CCount+1
                                        xlSheet.Cells(5,CCount).Value = DCmd.ID & "." & "Min"
                                        xlSheet.Cells(2,CCount).Value = DCmd.Nominal
                                        xlSheet.Cells(3,CCount).Value = DCmd.Plus
                                        xlSheet.Cells(4,CCount).Value = DCmd.Minus
                                        xlSheet.Cells(6,CCount).Value = DCmd.Min
                                      End If
                                      CCount=CCount+1
                          End If
                      End If
                  End If
                  'Do GDT
                  If Cmd.Type = 184 Then
                        ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                        If ReportDim = "BOTH" Or ReportDim = "STATS" Then
                              xlSheet.Cells(5,CCount).Value = Cmd.GetText (ID, 0) & "." & "FCF"
                              xlSheet.Cells(2,CCount).Value = "0"
                              xlSheet.Cells(3,CCount).Value = Cmd.GetText (LINE2_PLUSTOL, 1)
                              xlSheet.Cells(4,CCount).Value = "0"
                              xlSheet.Cells(6,CCount).Value = Cmd.GetText (LINE2_DEV, 1)
                              CCount=CCount+1
                        End If
                  End If
              End If
          Next Cmd
      
      
      Else
      
      'Find first Open column.
      RCount=6
      Found=0
      Do Until Found = 1
      RCount = RCount + 1
      If xlSheet.Cells(RCount,1).Value = "" Then
      Found=1
      End If
      Loop
      
      xlSheet.Cells(RCount,1).Value = Date() & " " & Time()
      
      'Fill In measured data
      CCount = 3
          For Each Cmd In Cmds
              'Eliminate DATDEF's
              If Cmd.Type <> 1299 Then
                  'Do Dimensions
                  If Cmd.IsDimension Then
                      If Cmd.Type = DIMENSION_START_LOCATION Or Cmd.Type = DIMENSION_TRUE_START_POSITION Then
                          Set DcmdID = Cmd.DimensionCommand
                            DimID = DcmdID.ID
                            ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                      End If
                      If Cmd.Type <> DIMENSION_START_LOCATION And Cmd.Type <> DIMENSION_END_LOCATION And _
                          Cmd.Type <> DIMENSION_TRUE_START_POSITION And Cmd.Type <> DIMENSION_TRUE_END_POSITION Then
                          Set DCmd = Cmd.DimensionCommand
                          CheckDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                          If CheckDim <> "" Then
                                  ReportDim = CheckDim
                          End If
                          If ReportDim = "BOTH" Or ReportDim = "STATS" Then
                                      'Measured Or Deviation With check For True Position
                                    If DCmd.AxisLetter <> "TP" Then
                                        xlSheet.Cells(RCount,CCount).Value = DCmd.Measured
                      Else
                                        xlSheet.Cells(RCount,CCount).Value = DCmd.Deviation
                      End If
                                      'Add Min/Max For Profile dimensions
                                      If Cmd.Type = 1118 Or Cmd.Type = 1105 Then
                                        CCount=CCount+1
                                        xlSheet.Cells(RCount,CCount).Value = DCmd.Max
                                        CCount=CCount+1
                                        xlSheet.Cells(RCount,CCount).Value = DCmd.Min
                                      End If
                             Ccount=Ccount+1
                          End If
                      End If
                  End If
                  'Do GDT
                  If Cmd.Type = 184 Then
                        ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                        If ReportDim = "BOTH" Or ReportDim = "STATS" Then
                              xlSheet.Cells(RCount,CCount).Value = Cmd.GetText (ID, 0) & "." & "FCF"
                              xlSheet.Cells(RCount,CCount).Value = "0"
                              xlSheet.Cells(RCount,CCount).Value = Cmd.GetText (LINE2_PLUSTOL, 1)
                              xlSheet.Cells(RCount,CCount).Value = "0"
                              xlSheet.Cells(RCount,CCount).Value = Cmd.GetText (LINE2_DEV, 1)
                              CCount=CCount+1
                        End If
                  End If
              End If
          Next Cmd
      End If
      
      
      'Save And Cleanup
      Set xlSheet = Nothing 
      SaveName = FilePath & Part.partname & ".xls"
      If ResFileExists = False Then
      xlWorkBook.SaveAs SaveName
      Else
      xlWorkBook.Save
      End If
      xlWorkbook.Close
      Set xlWorkbook = Nothing 
      xlWorkbooks.Close 
      Set xlWorkbooks = Nothing 
      xlApp.Quit 
      Set xlApp = Nothing
      
      LabelEnd:
      
      End Sub

      Comment


      • #4
        As InspectorJester says, swap the rows and columns in xlSheet.Cells(RCount,CCount) to xlSheet.Cells(CCount,RCount) and any xlSheet.Range("B1") to xlSheet.Range("A2") (the letter B becomes the number 2, the number 1 becomes the letter A, and they swap place).
        AndersI
        SW support - Hexagon Metrology Nordic AB

        Comment


        • #5
          Originally posted by AndersI View Post
          As InspectorJester says, swap the rows and columns in xlSheet.Cells(RCount,CCount) to xlSheet.Cells(CCount,RCount) and any xlSheet.Range("B1") to xlSheet.Range("A2") (the letter B becomes the number 2, the number 1 becomes the letter A, and they swap place).
          I already tried that with no success.

          Comment


          • #6
            The "reverse" script

            Code:
            Sub Main  (strVariable As String)
            
            
            'xl Declarations
            Dim xlApp As Object
            Dim xlWorkbooks As Object
            Dim xlWorkbook As Object
            Dim xlSheet As Object
            Dim count As Integer
            
            
            'pcdlrn declarations And Open ppg
            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 Object
            Dim DCmd As Object
            Dim DcmdID As Object
            Dim DimID As String
            Dim fs As Object
            Dim ReportDim As String
            Dim CheckDim As String
            
            
            'Check To see If results file exists
            FilePath = "C:\Excel Data\"
            Set fs = CreateObject("Scripting.FileSystemObject")
            ResFileExists = fs.fileexists(FilePath & Part.partname & " " &  strVariable & ".xls")
            
            
            'Open Excel And Base form
            Set xlApp = CreateObject("Excel.Application")
            Set xlWorkbooks = xlapp.Workbooks
            If ResFileExists = False Then
                TempFilename = FilePath & "Loop Template Column.xls"
            Else
                TempFilename = FilePath & Part.partname & " " &  strVariable & ".xls"
            End If
            Set xlWorkbook = xlWorkbooks.Open(TempFilename)
            Set xlSheet = xlWorkbook.Worksheets("Sheet1")
            
            
            If ResFileExists = False Then
                CCount=6
                RCount=3
                xlSheet.Range("B1").Value = Part.PartName
                xlSheet.Range("A6").Value = Date() & " " & Time()
                xlSheet.Range("D1").Value = strVariable
            
            
                For Each Cmd In Cmds
                    'Eliminate DATDEF's
                    If Cmd.Type <> 1299 Then
                        'Do Dimensions
                        If Cmd.IsDimension Then
                            If Cmd.Type = DIMENSION_START_LOCATION Or Cmd.Type = DIMENSION_TRUE_START_POSITION Then
                                Set DcmdID = Cmd.DimensionCommand
                                  DimID = DcmdID.ID
                                  ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                            End If
                            If Cmd.Type <> DIMENSION_START_LOCATION And Cmd.Type <> DIMENSION_END_LOCATION And _
                                Cmd.Type <> DIMENSION_TRUE_START_POSITION And Cmd.Type <> DIMENSION_TRUE_END_POSITION Then
                                Set DCmd = Cmd.DimensionCommand
                                CheckDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                                If CheckDim <> "" Then
                                        ReportDim = CheckDim
                                End If
                                If ReportDim = "BOTH" Or ReportDim = "STATS" Then
                                    If DCmd.ID = "" Then
                                            xlSheet.Cells(5,RCount).Value = DimID
                                    Else
                                            xlSheet.Cells(5,RCount).Value = DCmd.ID
                                    End If
                                            xlSheet.Cells(2,RCount).Value = DCmd.Nominal
                                            xlSheet.Cells(3,RCount).Value = DCmd.Plus
                                            xlSheet.Cells(4,RCount).Value = DCmd.Minus
                                            'Measured Or Deviation With check For True Position
                                  If DCmd.AxisLetter <> "TP" Then
                                              xlSheet.Cells(6,RCount).Value = DCmd.Measured
                            Else
                                              xlSheet.Cells(6,RCount).Value = DCmd.Deviation
                            End If
                                            'Add Min/Max For Profile dimensions
                                            If Cmd.Type = 1118 Or Cmd.Type = 1105 Then
                                              RCount=RCount+1
                                              xlSheet.Cells(5,RCount).Value = DCmd.ID & "." & "Max"
                                              xlSheet.Cells(2,RCount).Value = DCmd.Nominal
                                              xlSheet.Cells(3,RCount).Value = DCmd.Plus
                                              xlSheet.Cells(4,RCount).Value = DCmd.Minus
                                              xlSheet.Cells(6,RCount).Value = DCmd.Max
                                              RCount=RCount+1
                                              xlSheet.Cells(5,RCount).Value = DCmd.ID & "." & "Min"
                                              xlSheet.Cells(2,RCount).Value = DCmd.Nominal
                                              xlSheet.Cells(3,RCount).Value = DCmd.Plus
                                              xlSheet.Cells(4,RCount).Value = DCmd.Minus
                                              xlSheet.Cells(6,RCount).Value = DCmd.Min
                                            End If
                                            RCount=RCount+1
                                End If
                            End If
                        End If
                        'Do GDT
                        If Cmd.Type = 184 Then
                              ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                              If ReportDim = "BOTH" Or ReportDim = "STATS" Then
                                    xlSheet.Cells(5,RCount).Value = Cmd.GetText (ID, 0) & "." & "FCF"
                                    xlSheet.Cells(2,RCount).Value = "0"
                                    xlSheet.Cells(3,RCount).Value = Cmd.GetText (LINE2_PLUSTOL, 1)
                                    xlSheet.Cells(4,RCount).Value = "0"
                                    xlSheet.Cells(6,RCount).Value = Cmd.GetText (LINE2_DEV, 1)
                                    RCount=RCount+1
                              End If
                        End If
                    End If
                Next Cmd
            
            
            Else
            
            'Find first Open column.
            CCount=6
            Found=0
            Do Until Found = 1
            CCount = CCount + 1
            If xlSheet.Cells(CCount,1).Value = "" Then
            Found=1
            End If
            Loop
            
            xlSheet.Cells(CCount,1).Value = Date() & " " & Time()
            
            'Fill In measured data
            RCount = 3
                For Each Cmd In Cmds
                    'Eliminate DATDEF's
                    If Cmd.Type <> 1299 Then
                        'Do Dimensions
                        If Cmd.IsDimension Then
                            If Cmd.Type = DIMENSION_START_LOCATION Or Cmd.Type = DIMENSION_TRUE_START_POSITION Then
                                Set DcmdID = Cmd.DimensionCommand
                                  DimID = DcmdID.ID
                                  ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                            End If
                            If Cmd.Type <> DIMENSION_START_LOCATION And Cmd.Type <> DIMENSION_END_LOCATION And _
                                Cmd.Type <> DIMENSION_TRUE_START_POSITION And Cmd.Type <> DIMENSION_TRUE_END_POSITION Then
                                Set DCmd = Cmd.DimensionCommand
                                CheckDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                                If CheckDim <> "" Then
                                        ReportDim = CheckDim
                                End If
                                If ReportDim = "BOTH" Or ReportDim = "STATS" Then
                                            'Measured Or Deviation With check For True Position
                                          If DCmd.AxisLetter <> "TP" Then
                                              xlSheet.Cells(CCount,RCount).Value = DCmd.Measured
                            Else
                                              xlSheet.Cells(CCount,RCount).Value = DCmd.Deviation
                            End If
                                            'Add Min/Max For Profile dimensions
                                            If Cmd.Type = 1118 Or Cmd.Type = 1105 Then
                                              RCount=RCount+1
                                              xlSheet.Cells(CCount,RCount).Value = DCmd.Max
                                              RCount=RCount+1
                                              xlSheet.Cells(CCount,RCount).Value = DCmd.Min
                                            End If
                                   Rcount=Rcount+1
                                End If
                            End If
                        End If
                        'Do GDT
                        If Cmd.Type = 184 Then
                              ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                              If ReportDim = "BOTH" Or ReportDim = "STATS" Then
                                    xlSheet.Cells(CCount,RCount).Value = Cmd.GetText (ID, 0) & "." & "FCF"
                                    xlSheet.Cells(CCount,RCount).Value = "0"
                                    xlSheet.Cells(CCount,RCount).Value = Cmd.GetText (LINE2_PLUSTOL, 1)
                                    xlSheet.Cells(CCount,RCount).Value = "0"
                                    xlSheet.Cells(CCount,RCount).Value = Cmd.GetText (LINE2_DEV, 1)
                                    RCount=RCount+1
                              End If
                        End If
                    End If
                Next Cmd
            End If
            
            
            'Save And Cleanup
            Set xlSheet = Nothing
            SaveName = FilePath & Part.partname & " " & strVariable  & ".xls"
            If ResFileExists = False Then
            xlWorkBook.SaveAs SaveName
            Else
            xlWorkBook.Save
            End If
            xlWorkbook.Close
            Set xlWorkbook = Nothing
            xlWorkbooks.Close
            Set xlWorkbooks = Nothing
            xlApp.Quit
            Set xlApp = Nothing
            
            LabelEnd:
            
            End Sub
            With some other changes.

            Comment


            • #7
              Silly me. I missed a bunch of CCount and RCount commands to be flipped. I think i'm on the right track now.

              Comment

              Related Topics

              Collapse

              Working...
              X