PC-Dmis to Excel, through PC-Dmis Script

I know there is currently a VB project that runs in Excel during execution that will pull information into the workbook during execution. I decided to venture out and try some of my own approaches with a combination of data I found online here and there.

What I have is a script that can be executed in program, without too much setup and hassle, that will export data into an excel workbook like a print command would. I feel this script offers a little more versatility.

I will not claim ownership of this program. I just tweaked it to fit my needs. So far I have it running, and it works quite well.

I will answer what questions I can, but for the most part I wanted to post it to have as a reference.

It's a long program........

Parents

Rploughe over 9 years ago

If objFSO.FileExists(ResFileExists) = True Then
    Dim Aver, Mini, Maxi, StdDevv, Ranger, Meani, Cp, Cpk
    Dim MyRange As Range
    Dim Startcell, EndCell, Tcount, Scount
    Dim Col, lCol
    Rcount = Rcount
 Ccount = 3
 Scount = 12
 Tcount = Rcount-Scount
    Rcount = Rcount+2
    xlsheet.cells(Rcount-1,1).Value = ""
    xlsheet.cells(Rcount+0,1).Value = "Max"
    xlsheet.cells(Rcount+1,1).Value = "Min"
    xlsheet.cells(Rcount+2,1).Value = "Range"
    xlsheet.cells(Rcount+3,1).Value = "--"
    xlsheet.cells(Rcount+4,1).Value = "Average"
    xlsheet.cells(Rcount+5,1).Value = "Mean"
    xlsheet.cells(Rcount+6,1).Value = "Std Dev"
    xlsheet.cells(Rcount+7,1).Value = "--"
    xlsheet.cells(Rcount+8,1).Value = "Cp"
    xlsheet.cells(Rcount+9,1).Value = "CpK"
    xlsheet.cells(Rcount+10,1).Value = "Count"
    xlsheet.cells(Rcount-1,2).Value = "--"
    xlsheet.cells(Rcount+0,2).Value = "--"
    xlsheet.cells(Rcount+1,2).Value = "--"
    xlsheet.cells(Rcount+2,2).Value = "--"
    xlsheet.cells(Rcount+3,2).Value = "--"
    xlsheet.cells(Rcount+4,2).Value = "--"
    xlsheet.cells(Rcount+5,2).Value = "--"
    xlsheet.cells(Rcount+6,2).Value = "--"
    xlsheet.cells(Rcount+7,2).Value = "--"
    xlsheet.cells(Rcount+8,2).Value = "--"
    xlsheet.cells(Rcount+9,2).Value = "--"
    xlsheet.cells(Rcount+10,2).Value = "--"    NotFound = 0
    Do Until NotFound = 1
         If xlSheet.Cells(7, CCount).Value <> "" Then ' FCF
         xlsheet.cells(Rcount-1,Ccount).Value = "--"
         xlsheet.cells(Rcount+0,Ccount).Value = fncsheet.Max(xlsheet.Range(xlsheet.cells(Scount,Ccount),(xlsheet.cells(Scount+Tcount,Ccount))))
         xlsheet.cells(Rcount+1,Ccount).Value = fncsheet.Min(xlsheet.Range(xlsheet.cells(Scount,Ccount),(xlsheet.cells(Scount+Tcount,Ccount))))
         'Controls Range of Meas, Max-Min
         xlsheet.cells(Rcount+2,Ccount).Value = fncsheet.Sum(xlsheet.Cells(Rcount+0,Ccount).value,-(xlsheet.Cells(Rcount+1,Ccount).value))
         xlsheet.cells(Rcount+3,Ccount).Value = "--"
         xlsheet.cells(Rcount+4,Ccount).Value = fncsheet.Average(xlsheet.Range(xlsheet.cells(Scount,Ccount),(xlsheet.cells(Scount+Tcount,Ccount))))
         xlsheet.cells(Rcount+5,Ccount).Value = fncsheet.Median(xlsheet.Range(xlsheet.cells(Scount,Ccount),(xlsheet.cells(Scount+Tcount,Ccount))))
         xlsheet.cells(Rcount+6,Ccount).Value = fncsheet.STDEVP(xlsheet.Range(xlsheet.cells(Scount,Ccount),(xlsheet.cells(Scount+Tcount,Ccount))))
         xlsheet.cells(Rcount+7,Ccount).Value = "--"
         If xlsheet.cells(10,Ccount).Value <> 0 Then
              xlsheet.cells(Rcount+8,Ccount).Value = _
                   (xlsheet.cells(9,Ccount).Value-xlsheet.cells(10,Ccount).Value)/(6*xlsheet.cells(Rcount+6,Ccount).value)
              xlsheet.cells(Rcount+9,Ccount).Value = fncsheet.Min( _
                   (xlsheet.cells(9,Ccount).Value-xlsheet.cells(Rcount+4,Ccount).Value) /(3*xlsheet.cells(Rcount+6,Ccount).value) _
                   ,(xlsheet.cells(Rcount+4,Ccount).Value-xlsheet.cells(10,Ccount).Value)/(3*xlsheet.cells(Rcount+6,Ccount).value))
         Else
              xlsheet.cells(Rcount+8,Ccount).Value = _
                   (xlsheet.cells(9,Ccount).Value)/(6*xlsheet.cells(Rcount+6,Ccount).value)
              xlsheet.cells(Rcount+9,Ccount).Value = _
                   (xlsheet.cells(9,Ccount).Value-xlsheet.cells(Rcount+4,Ccount).Value) /(3*xlsheet.cells(Rcount+6,Ccount).value)
         End If
              xlsheet.cells(Rcount+10,Ccount).Value = Rcount-Scount-1
         CCount = CCount + 1
         NotFound = 0
         Else 
         NotFound = 1
         End If 
Loop
End If
'Save And Cleanup
If objFSO.FileExists(ResFileExists) = False Then
    xlWorkBook.SaveAs ResFileExists
Else
    xlWorkBook.Save
End If
    Set xlSheet = Nothing 
xlWorkbook.Close
    Set xlWorkbook = Nothing 
xlWorkbooks.Close 
    Set xlWorkbooks = Nothing 
xlApp.Quit
    Set xlApp = Nothing
Exit Sub
ErrorCheck:
Set xlSheet = Nothing 
xlWorkbook.Close
    Set xlWorkbook = Nothing 
xlWorkbooks.Close 
    Set xlWorkbooks = Nothing 
xlApp.Quit
    Set xlApp = Nothing
End Sub

Reply

Rploughe over 9 years ago

If objFSO.FileExists(ResFileExists) = True Then
    Dim Aver, Mini, Maxi, StdDevv, Ranger, Meani, Cp, Cpk
    Dim MyRange As Range
    Dim Startcell, EndCell, Tcount, Scount
    Dim Col, lCol
    Rcount = Rcount
 Ccount = 3
 Scount = 12
 Tcount = Rcount-Scount
    Rcount = Rcount+2
    xlsheet.cells(Rcount-1,1).Value = ""
    xlsheet.cells(Rcount+0,1).Value = "Max"
    xlsheet.cells(Rcount+1,1).Value = "Min"
    xlsheet.cells(Rcount+2,1).Value = "Range"
    xlsheet.cells(Rcount+3,1).Value = "--"
    xlsheet.cells(Rcount+4,1).Value = "Average"
    xlsheet.cells(Rcount+5,1).Value = "Mean"
    xlsheet.cells(Rcount+6,1).Value = "Std Dev"
    xlsheet.cells(Rcount+7,1).Value = "--"
    xlsheet.cells(Rcount+8,1).Value = "Cp"
    xlsheet.cells(Rcount+9,1).Value = "CpK"
    xlsheet.cells(Rcount+10,1).Value = "Count"
    xlsheet.cells(Rcount-1,2).Value = "--"
    xlsheet.cells(Rcount+0,2).Value = "--"
    xlsheet.cells(Rcount+1,2).Value = "--"
    xlsheet.cells(Rcount+2,2).Value = "--"
    xlsheet.cells(Rcount+3,2).Value = "--"
    xlsheet.cells(Rcount+4,2).Value = "--"
    xlsheet.cells(Rcount+5,2).Value = "--"
    xlsheet.cells(Rcount+6,2).Value = "--"
    xlsheet.cells(Rcount+7,2).Value = "--"
    xlsheet.cells(Rcount+8,2).Value = "--"
    xlsheet.cells(Rcount+9,2).Value = "--"
    xlsheet.cells(Rcount+10,2).Value = "--"    NotFound = 0
    Do Until NotFound = 1
         If xlSheet.Cells(7, CCount).Value <> "" Then ' FCF
         xlsheet.cells(Rcount-1,Ccount).Value = "--"
         xlsheet.cells(Rcount+0,Ccount).Value = fncsheet.Max(xlsheet.Range(xlsheet.cells(Scount,Ccount),(xlsheet.cells(Scount+Tcount,Ccount))))
         xlsheet.cells(Rcount+1,Ccount).Value = fncsheet.Min(xlsheet.Range(xlsheet.cells(Scount,Ccount),(xlsheet.cells(Scount+Tcount,Ccount))))
         'Controls Range of Meas, Max-Min
         xlsheet.cells(Rcount+2,Ccount).Value = fncsheet.Sum(xlsheet.Cells(Rcount+0,Ccount).value,-(xlsheet.Cells(Rcount+1,Ccount).value))
         xlsheet.cells(Rcount+3,Ccount).Value = "--"
         xlsheet.cells(Rcount+4,Ccount).Value = fncsheet.Average(xlsheet.Range(xlsheet.cells(Scount,Ccount),(xlsheet.cells(Scount+Tcount,Ccount))))
         xlsheet.cells(Rcount+5,Ccount).Value = fncsheet.Median(xlsheet.Range(xlsheet.cells(Scount,Ccount),(xlsheet.cells(Scount+Tcount,Ccount))))
         xlsheet.cells(Rcount+6,Ccount).Value = fncsheet.STDEVP(xlsheet.Range(xlsheet.cells(Scount,Ccount),(xlsheet.cells(Scount+Tcount,Ccount))))
         xlsheet.cells(Rcount+7,Ccount).Value = "--"
         If xlsheet.cells(10,Ccount).Value <> 0 Then
              xlsheet.cells(Rcount+8,Ccount).Value = _
                   (xlsheet.cells(9,Ccount).Value-xlsheet.cells(10,Ccount).Value)/(6*xlsheet.cells(Rcount+6,Ccount).value)
              xlsheet.cells(Rcount+9,Ccount).Value = fncsheet.Min( _
                   (xlsheet.cells(9,Ccount).Value-xlsheet.cells(Rcount+4,Ccount).Value) /(3*xlsheet.cells(Rcount+6,Ccount).value) _
                   ,(xlsheet.cells(Rcount+4,Ccount).Value-xlsheet.cells(10,Ccount).Value)/(3*xlsheet.cells(Rcount+6,Ccount).value))
         Else
              xlsheet.cells(Rcount+8,Ccount).Value = _
                   (xlsheet.cells(9,Ccount).Value)/(6*xlsheet.cells(Rcount+6,Ccount).value)
              xlsheet.cells(Rcount+9,Ccount).Value = _
                   (xlsheet.cells(9,Ccount).Value-xlsheet.cells(Rcount+4,Ccount).Value) /(3*xlsheet.cells(Rcount+6,Ccount).value)
         End If
              xlsheet.cells(Rcount+10,Ccount).Value = Rcount-Scount-1
         CCount = CCount + 1
         NotFound = 0
         Else 
         NotFound = 1
         End If 
Loop
End If
'Save And Cleanup
If objFSO.FileExists(ResFileExists) = False Then
    xlWorkBook.SaveAs ResFileExists
Else
    xlWorkBook.Save
End If
    Set xlSheet = Nothing 
xlWorkbook.Close
    Set xlWorkbook = Nothing 
xlWorkbooks.Close 
    Set xlWorkbooks = Nothing 
xlApp.Quit
    Set xlApp = Nothing
Exit Sub
ErrorCheck:
Set xlSheet = Nothing 
xlWorkbook.Close
    Set xlWorkbook = Nothing 
xlWorkbooks.Close 
    Set xlWorkbooks = Nothing 
xlApp.Quit
    Set xlApp = Nothing
End Sub

Children

No Data