'By Jeremy Carlson - Michigan Technological University - jmcarlso@mtu.edu
'*******************************************************************************************
'*******************************************************************************************
' Visual Basic Script to Take Scanned Black and White Images of Portland Cement Concrete
' and Analyze Air Void systems per ASTM C457 Procedure A and B.  Also allows for the ability
' to perform a manual point count on an image in order to determine the paste content of the
' sample for use in the ASTM C457 calculations.
'
' This version of the script "bubble_counter_v2007.0.vbs" has been modified slightly
' by Karl Peterson - krpeters@mtu.edu
'*******************************************************************************************
'Additional notes from K. Peterson:
'
'This version of Jeremy's script is designed to run batches of images that have already been
'cropped down to the area desired to be analyzed. It requires an excel file with a list of
'the filenames (without .tif extension), and numbers for either the paste volume to aggregate
'volume ratio (from mix design) or the paste volume or aggregate volume (from point count,
'or from just guessing). The batch file should be named "batch_file.xls" and placed in
'the location Path1 (below).
'
'*******************************************************************************************
' Define locations of files and folders used in analysis.

' IPath is the location of the testing lab's logo which is displayed on the final report.
' ***Note: for the report to format properly the logo should be 360 pixels wide by 67 pixels high.***
Ipath = "C:\Program Files\AirVoids\Misc\MTU.gif"
PathA = "C:\Program Files\AirVoids\Misc\"

' Path1 is the location of the scanned images to be analyzed by the program
Path1 = "C:\Program Files\AirVoids\ScannedImages\"

' Path2 is the location where images and files are stored during the operation
Path2 = "C:\Program Files\AirVoids\AnalysisData\"

' Path3 is the location of the saved Result files created by the program
Path3 = "C:\Program Files\AirVoids\Results\"

' Helper is the location of the C457.hlp file.
' ***Note: if the help file is placed in the same folder as the *.vbs file, the next line can be left as is.***
Helper = "C457.hlp"
'*******************************************************************************************
'*******************************************************************************************
'*******************************************************************************************
'*******************************************************************************************
' Set Location of Input Boxes to be Displayed on Screen
XBox = 7000
YBox = 4000
XBox2 = 10000
YBox2 = 2000
'*******************************************************************************************
'###########################################################################################
'Set parameters for Batch Analyses

'NumIts is the "number of iterations." It controls the total traverse length, one iteration
'equals one set of 19 parallel lines. The total length depends on the size of the area analyzed.
'If doing multiple iterations, the position of the set of 19 lines is shifted between iterations.

'ThreshValue is the threshold value (a constant) you wish to use for the analyses

'You will also need to fill out an excel spreadsheet named "batch_file.xls" that contains the
'filenames (without the .tif extension) and corresponding values for either the paste/aggregate
'volume ratio (from mix design) or the paste vol% or the agg vol% (from either guessing or point
'counting.

'###########################################################################################
NumIts = 3
ThreshValue = 91
BatchFile = Path1 & "batch_file.xls"
BatchTemp = Path1 & "batch_temp.xls"
Set xlsApp = CreateObject("Excel.Application")
  With xlsApp
   xlsApp.Visible = False
  End With
xlsApp.Workbooks.Open BatchFile
xlsApp.Range("A1:D102").Select
  xlsApp.Selection.Copy
xlsApp.Workbooks.Add
  xlsApp.Selection.PasteSpecial 12
xlsApp.Range("F1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=COUNTA(R[1]C[-5]:R[101]C[-5])"
BatchDone = xlsApp.Range("F1")
xlsApp.DisplayAlerts = False
  xlsApp.ActiveWorkbook.Close False
   xlsApp.ActiveWorkbook.Close True
   xlsApp.Quit
BatchNum = 0
Do Until BatchNum = BatchDone
BatchNum = BatchNum + 1
CellNum = BatchNum + 1
Cell = "A" & CellNum
CellPasteAggRatio = "B" & CellNum
CellPastePercent = "C" & CellNum
CellAggPercent = "D" & CellNum
CellManAir = "E" & CellNum
CellManFreq = "F" & CellNum
Set xlsApp = CreateObject("Excel.Application")
  With xlsApp
   xlsApp.Visible = False
   xlsApp.Workbooks.Open BatchFile
  End With
    Defaultfile = xlsApp.Range(Cell)
    ManAir = xlsApp.Range(CellManAir)
    ManVoidFreq = xlsApp.Range(CellManFreq)
    TestPa = xlsApp.Range(CellPasteAggRatio)
    TestPp = xlsApp.Range(CellPastePercent)
    TestAp = xlsApp.Range(CellAggPercent)
     If TestPp > 1 Then
     Datachunk = "pp"
     Paste = TestPp
     Else
      If TestAp > 1 Then
      Datachunk = "ap"
      NotAggPct = 100 - TestAp
       Else
       Datachunk = "pa"
       PasteAggRatio = TestPa
      End If
     End If
   xlsApp.ActiveWindow.Close True, BatchFile
   xlsApp.Quit

ProjID = "dissertation"
SampleID = Defaultfile
TestLab = "Purdue"
Nerd1 = "Matt"
Nerd2 = "Matt"
SaveFileName = Defaultfile
file = Defaultfile
Filename = Path1 & file & ".tif"

 '*******************************************************************************************
 ' Define Photoshop Application to Be Used In Script
 Set appRef1 = CreateObject("Photoshop.Application")
 '*******************************************************************************************
 ' Sets Photoshop Ruler Units as Pixels
 strtRulerUnits = appRef1.Preferences.RulerUnits
 appRef1.Preferences.RulerUnits = 1
 '*******************************************************************************************
    ' Open Scanned Image
   Set ScanDoc = appRef1.Open(Filename)


'*******************************************************************************************
' Defines the resolution (fixed as constant in this version)

Resolution = 8
Xsel = ScanDoc.Width
Ysel = ScanDoc.Height




' Figures out the dimensions of the area selected for analysis for the dumbed-down image inlcuded in the report

If Ysel > Xsel Then
Aj = Ysel / 586
Xa = Xsel / Aj
Ya = Ysel / Aj
PicRatio = 300 / 586
ActualRatio = Xa / Ya
If ActualRatio > PicRatio Then
Ak = Xa / 300
Xa = Xa / Ak
Ya = Ya / Ak
End If
Else
Aj = Xsel / 300
Xa = Xsel / Aj
Ya = Ysel / Aj
End If

'*******************************************************************************************
' Create Excel Sized (2 pix wide) Sections of Scanned Image

NumberRotations=1
For Rot = 1 To NumberRotations
 For Trials = 1 To NumIts
 If FilterYN = 6 Then
  w = 125
 Else
  w = 2
 End If
 X = ScanDoc.Width
 i = 0
 n = Round(X / 19, 0)
  For j = 1 To 19
  ScanDoc.Selection.Select Array(Array(i * n + Trials, 0), Array(w + i * n + Trials, 0), Array(w + i * n + Trials, Ysel), Array(i * n + Trials, Ysel))
  ScanDoc.Selection.Copy

  ' Create New Image of Copied Section of Scanned Image and Paste Copied Section
  fileName2 = Rot & "_" & Trials & "_Clip" & i
  Set fileName4 = appRef1.Documents.Add(w, Ysel,72,"temp",1)
   fileName4.ActiveLayer.Invert
  fileName4.Paste
  fileName4.Flatten
  If FilterYN = 6 Then
   fileName4.ResizeCanvas 2, Ysel
   fileName3 = Path2 & fileName2 & ".tif"
   fileName4.SaveAs fileName3
   appRef1.DoAction "CliptoText", "C457.atn"
   fileName4.Close
  Else
   fileName4.ResizeCanvas 2, Ysel
   fileName3 = Path2 & fileName2 & ".tif"
 
Set tifSaveOptions = CreateObject( "Photoshop.TIFFSaveOptions" )
tifSaveOptions.ImageCompression = 1
filename4.SaveAs filename3, tifSaveOptions, True, extType


   fileName4.close ( 2)
  End If
  i = i + 1
  Next
 Next
' here's where to insert "ScanDoc.RotateCanvas 90" if the NumberRotations is set to >1.
Next
'*******************************************************************************************
' Resize and Save Image for Display on Opening Page of Final Report
Set ScanDoc = appRef1.ActiveDocument
ScanDoc.ResizeImage Xa, Ya, 150, 4
ThumbNailx = ScanDoc.Width
ThumbNailY = ScanDoc.Height
    
Set Bcolor = appRef1.BackgroundColor

    With Bcolor
        .RGB.Red = 255
        .RGB.Green = 255
        .RGB.Blue = 255
    End With

ScanDoc.ResizeCanvas 300, 586
fileNameRa = "Report.jpg"
fileNameR = Path1 & fileNameRa

Set jpgSaveOptions = CreateObject("Photoshop.JPEGSaveOptions")
jpgSaveOptions.EmbedColorProfile = True
jpgSaveOptions.FormatOptions = 1
jpgSaveOptions.Matte = 1
jpgSaveOptions.Quality = 10
ScanDoc.SaveAs fileNameR, jpgSaveOptions, True, extType
ScanDoc.Close (2)

' Create Mosaic File of 2 pix wide sections obtained in previous step

For Rot2 = 1 To NumberRotations
 For Mos = 1 To NumIts
  Set Mosaic = appRef1.Documents.Add(19,Ysel,72,"temp",1)
  l = -9
  For k = 0 To 18
   m = (-1 * l) - k
   MosaicFile = Rot2 & "_" & Mos & "_Clip" & k & ".tif"
   MfileName = Path2 & MosaicFile
   MDoc = "MDoc" & q
   Set MDoc = appRef1.Open(MfileName)
   MDoc.Selection.SelectAll
   MDoc.Selection.Copy
   MDoc.Close 2
   Mosaic.Paste
   Mosaic.ActiveLayer.Translate m, 0
   Mosaic.Flatten
  Next
  fileNameMM = Rot2 & "_" & Mos & "_ClipMosaic"
  fileNameMMM = Path2 & fileNameMM & ".tif"
Mosaic.SaveAs fileNameMMM, tifSaveOptions, True, extType
  Mosaic.Close 2
 Next
Next

'make worksheet to store results of optimum threshold search

If BatchNum = 1 Then
Set xlsApp = Createobject("Excel.Application")
  With xlsApp
   xlsApp.Visible = True
   xlsApp.Workbooks.Add
  End With
 xlsApp.Range("A1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=NOW()"
 xlsApp.Range("A2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=DAY(R[-1]C)"
 xlsApp.Range("A3").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=MONTH(R[-2]C)"
 xlsApp.Range("A4").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=YEAR(R[-3]C)"
 xlsApp.Range("A2:A4").Select
 xlsApp.Selection.Copy   
 xlsApp.Selection.pastespecial 12
 OptOne = xlsApp.Range("A2")
 OptTwo = xlsApp.Range("A3")
 OptThree = xlsApp.Range("A4")

OptThreshFile = Path3 & "Summary_" & OptOne & "_" & OptTwo & "_" & OptThree & ".xls"
 xlsApp.Range("A1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Filename"
 xlsApp.Range("B1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Air Pix"
 xlsApp.Range("C1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Not Air Pix"
 xlsApp.Range("D1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Total Pix"
 xlsApp.Range("F1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Air %"
 xlsApp.Range("G1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Not Air %"
 xlsApp.Range("H1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Total %"
 xlsApp.Range("J1").select
 xlsApp.ActiveCell.FormulaR1C1 = "# Intercepts"
 xlsApp.Range("K1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Traverse Pix"
 xlsApp.Range("L1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Res/Pixel"
 xlsApp.Range("M1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Trav. (mm)"
 xlsApp.Range("N1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Voids/mm"
 xlsApp.Range("O1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Paste %"
 xlsApp.Range("P1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Paste/Air"
 xlsApp.Range("Q1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Chord L."
 xlsApp.Range("R1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Sp. Surf."
 xlsApp.Range("S1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Sp. Factor"
    xlsApp.ActiveWindow.Close True, OptThreshFile
   xlsApp.Quit
Else
 Set xlsApp = CreateObject("Excel.Application")
   With xlsApp
    xlsApp.Visible = False
    xlsApp.DisplayAlerts = False
    xlsApp.Workbooks.Open OptThreshFile
   End With
 xlsApp.Range("A1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Filename"
 xlsApp.Range("B1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Air Pix"
 xlsApp.Range("C1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Not Air Pix"
 xlsApp.Range("D1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Total Pix"
 xlsApp.Range("F1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Air %"
 xlsApp.Range("G1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Not Air %"
 xlsApp.Range("H1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Total %"
 xlsApp.Range("J1").select
 xlsApp.ActiveCell.FormulaR1C1 = "# Intercepts"
 xlsApp.Range("K1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Traverse Pix"
 xlsApp.Range("L1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Res/Pixel"
 xlsApp.Range("M1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Trav. (mm)"
 xlsApp.Range("N1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Voids/mm"
 xlsApp.Range("O1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Paste %"
 xlsApp.Range("P1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Paste/Air"
 xlsApp.Range("Q1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Chord L."
 xlsApp.Range("R1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Sp. Surf."
 xlsApp.Range("S1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Sp. Factor"
   xlsApp.ActiveWindow.Close True, OptThreshFile
   xlsApp.Quit
End If

THold = ThreshValue
'*******************************************************************************************
' Open and Perform Calculations on ClipMosaic.txt files

For Rot3 = 1 to NumberRotations
 For Moscalc = 1 to NumIts
 fileName5 = Path2 & Rot3 & "_" & Moscalc & "_ClipMosaic" & ".tif"
Set ZDoc = appRef1.Open(fileName5)	
	ZDoc.ActiveLayer.Threshold THold  
	appRef1.DoAction "CliptoText", "C457.atn"
	fileName5 = Path2 & Rot3 & "_" & Moscalc & "_ClipMosaic" & ".txt"
	ZDoc.Close

 ' Define Applications to Be Used In Script
 Set xlsApp = Createobject("Excel.Application")
   With xlsApp
    xlsApp.Visible = True
    xlsApp.DisplayAlerts = False
    xlsApp.Workbooks.Open fileName5
   End With
 xlsApp.Rows("1:5").Select
 xlsApp.Selection.Insert Down 

 ' Insert Result Labels
 xlsApp.Range("A1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Air Pix"
 xlsApp.Range("B1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Other Pix"
 xlsApp.Range("C1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Total Pix"

 ' Count Number Pixels defined as Air
 xlsApp.Range("A2").Select
 Formy1a = Ysel + 3
 Formy1 = "=COUNTIF(R[4]C:R[" & Formy1a & "]C[18],""=255"")"
 xlsApp.ActiveCell.FormulaR1C1 = Formy1

 ' Count Number Pixels defined as Other than Air
 xlsApp.Range("B2").Select
 Formy2 = "=COUNTIF(R[4]C[-1]:R[" & Formy1a & "]C[17],""=0"")"
 xlsApp.ActiveCell.FormulaR1C1 = Formy2

 ' Sum above counts to give total Pixels in Count
 xlsApp.Range("C2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=SUM(RC[-2]:RC[-1])"   

 ' Insert Result Labels
 xlsApp.Range("E1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Air %"
 xlsApp.Range("F1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Other %"
 xlsApp.Range("G1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Total %"

 ' Calculate Percent Air From Count Data Above
 xlsApp.Range("E2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=100*(RC[-4]/RC[-2])"

 ' Calculate Percent Not Air From Count Data Above
 xlsApp.Range("F2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=100*(RC[-4]/RC[-3])"

 ' Sum above 2 values to verify they combine to 100%
 xlsApp.Range("G2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=SUM(RC[-2]:RC[-1])"

 ' Copy/Paste Calculated Values to cause cell values to be numerical, not formulae
 xlsApp.Range("A1:G2").Select
 xlsApp.Selection.Copy
 xlsApp.Range("A1:G2").Select
 xlsApp.Selection.pastespecial 12

 ' Calculate Number of Consecutive Air Pixels in Columnar Lines
 Formy3a = Ysel + 7
 Formy3 = "" & "A" & Formy3a & ""
 xlsApp.Range(Formy3).Select
 Formy4a = Ysel + 1
 Formy4 = "=IF(R[-" & Formy4a & "]C=0,0,(R[-" & Formy4a & "]C+(255*R[-1]C))/255)"
 xlsApp.ActiveCell.FormulaR1C1 = Formy4
 xlsApp.Range(Formy3).Select
 xlsApp.Selection.Copy
 Formy5b = (2*Ysel) + 6 
 Formy5 = "" & "A" & Formy3a & ":" & "S" & Formy5b & ""
 xlsApp.Range(Formy5).Select
 xlsApp.Activesheet.Paste

 ' Copy/Paste Calculated Values to cause cell values to be numerical, not formulae
 xlsApp.Range(Formy5).Select
 xlsApp.Selection.Copy
 xlsApp.Selection.pastespecial 12 

 ' Delete Unneeded Data Rows to reduce size of excel sheet
 Formy6a = Ysel + 5
 Formy6 = "" & "6" & ":" & Formy6a & ""
 xlsApp.Range(Formy6).Select
 xlsApp.Selection.Delete Up 

 ' Calculate the Length of Each Columnar Chord Intercept
 Formy7a = Ysel + 8
 Formy7 = "" & "A" & Formy7a & ""
 xlsApp.Range(Formy7).Select
 Formy8a = Ysel + 1
 Formy8 = "=IF(R[-" & Formy8a & "]C<=R[-" & Ysel & "]C,0,R[-" & Formy8a & "]C)"
 xlsApp.ActiveCell.FormulaR1C1 = Formy8
 xlsApp.Range(Formy7).Select
 xlsApp.Selection.Copy
 Formy9b = (2*Ysel) + 7 
 Formy9 = "" & "A" & Formy7a & ":" & "S" & Formy9b & ""
 xlsApp.Range(Formy9).Select
 xlsApp.Activesheet.Paste

 ' Copy/Paste Calculated Values to cause cell values to be numerical, not formulae
 xlsApp.Range(Formy9).Select
 xlsApp.Selection.Copy
 xlsApp.Selection.pastespecial 12 

 ' Delete Unneeded Data Rows to reduce size of excel sheet
 Formy10a = Ysel + 6
 Formy10 = "" & "7" & ":" & Formy10a & ""
 xlsApp.Range(Formy10).Select
 xlsApp.Selection.Delete Up

 ' Calculate total number air void intercepts
 xlsApp.Range("I2").Select
 Formy11a = Ysel + 5
 Formy11 = "=COUNTIF(R[6]C[-8]:R[" & Formy11a & "]C[10],"">0"")"
 xlsApp.ActiveCell.FormulaR1C1 = Formy11
 xlsApp.Range("I1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Tot.Int"

 ' Calculate number of pixels used in chord length calculations
 xlsApp.Range("J2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=RC[-7]"
 xlsApp.Range("J1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Trav.Pts"

 ' Display resolution per pixel of scanned image
 xlsApp.Range("K2").Select
 xlsApp.ActiveCell.FormulaR1C1 = Resolution
 xlsApp.Range("K1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Res/pixel"

 ' Calculate Total Length of Traverse Line
 xlsApp.Range("L2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=RC[-2]*RC[-1]*(10^-6)*(10^3)"
 xlsApp.Range("L1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Trav.(mm)"

 ' Calculate Number of Intercepts (voids) per mm of traverse line
 xlsApp.Range("M2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=RC[-4]/RC[-1]"
 xlsApp.Range("M1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Voids/mm" 

' Calculate (from Air % Value and Batch Weights) or Display (from input) Paste Percentage In Mix
If Datachunk = "pa" Then
   xlsApp.Range("S2").Select
   xlsApp.ActiveCell.FormulaR1C1 = PasteAggRatio
xlsApp.Range("N2").Select
   xlsApp.ActiveCell.FormulaR1C1 = "=(100-RC[-9])*((100*(RC[5]/(1+RC[5])))/100)"
Else
If Datachunk = "manualcount" Then
xlsApp.Range("S2").Select
   xlsApp.ActiveCell.FormulaR1C1 = NotAggPct
xlsApp.Range("N2").Select
   xlsApp.ActiveCell.FormulaR1C1 = "=RC[5]-RC[-9]" 
Else
If Datachunk = "pp" Then
   xlsApp.Range("N2").Select
   xlsApp.ActiveCell.FormulaR1C1 = Paste
 Else
If Datachunk = "ap" Then
   xlsApp.Range("S2").Select
   xlsApp.ActiveCell.FormulaR1C1 = NotAggPct
xlsApp.Range("N2").Select
   xlsApp.ActiveCell.FormulaR1C1 = "=RC[5]-RC[-9]" 
End If
 End If
End If
End If
 xlsApp.Range("N1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Paste %"

 ' Calculate Paste/Air Ratio
 xlsApp.Range("O2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=RC[-1]/RC[-10]"
 xlsApp.Range("O1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Paste/air" 

 ' Calculate Average Chord Length
 xlsApp.Range("P2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=RC[-11]/(100*RC[-3])"
 xlsApp.Range("P1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Chord L"

 ' Calculate Specific Surface Value
 xlsApp.Range("Q2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=(4/RC[-1])"
 xlsApp.Range("Q1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Sp.Surf"

 ' Calculate Spacing Factor
 xlsApp.Range("R2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=IF(RC[-3]<=4.342,RC[-4]/(400*RC[-5]),(3/RC[-1])*((1.4*((1+RC[-3])^(1/3)))-1))"
 xlsApp.Range("R1").select
 xlsApp.ActiveCell.FormulaR1C1 = "Sp.factor"

 ' Add Row for Spacing
 xlsApp.Rows("7").Select
 xlsApp.Selection.Insert Down
 
 ' Set Up Ranges for Use in Creating Chord Length Freq. Chart
 xlsApp.Range("A3").Select
 xlsApp.ActiveCell.FormulaR1C1 = "1"
 xlsApp.Range("B3").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=1+RC[-1]"
 xlsApp.Range("B3").Select
 xlsApp.Selection.Copy
 xlsApp.Range("C3:IV3").Select
 xlsApp.ActiveSheet.Paste
 xlsApp.Range("A7").Select
 xlsApp.ActiveCell.FormulaR1C1 = Resolution
 xlsApp.Range("A7").Select
 xlsApp.Selection.Copy
 xlsApp.Range("A7:IV7").Select
 xlsApp.ActiveSheet.Paste
 xlsApp.Range("A4").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=R[3]C*R[-1]C"
 xlsApp.Range("A4").Select
 xlsApp.Selection.Copy
 xlsApp.Range("B4:IV4").Select
 xlsApp.Activesheet.Paste
 
ChordAnalysis = 0

If ChordAnalysis = 1 Then

 ' Count up Chord Lengths for Each Range Set up Previously (Range: 1-256 pixels)
 xlsApp.Range("A5").Select
 Formy12a = Ysel + 3
 Formy12 = "=COUNTIF(R[4]:R[" & Formy12a & "],R[-2]C)"
 xlsApp.ActiveCell.FormulaR1C1 = Formy12
 xlsApp.Range("A5").Select
 xlsApp.Selection.Copy
 xlsApp.Range("B5:IV5").Select
 xlsApp.Activesheet.Paste

End If
 
 ' Copy/Paste Calculated Values to cause cell values to be numerical, not formulae
 xlsApp.Range("A1:IV5").Select
 xlsApp.Selection.Copy
 xlsApp.Selection.pastespecial 12
 
 ' Delete Unneeded Data Rows to reduce size of excel sheet
 Formy13a = Ysel + 8
 Formy13 = "" & "7" & ":" & Formy13a & ""
 xlsApp.Range(Formy13).Select
 xlsApp.Selection.Delete Up
 xlsApp.Range("A1").Select
 
 ' Add Row for Spacing
 xlsApp.Rows("3").Select
 xlsApp.Selection.Insert Down
 xlsApp.Rows("5").Select

 DataAn = Rot3 & "_" & MosCalc & "_ClipMosaic"
 filenameJC = Path2 & "junkme.xls"

 xlsApp.Sheets(DataAn).Select
 xlsApp.Range("A1:IC6").Select
 xlsApp.Selection.Copy

 If Rot3 = 1 Then
  If MosCalc = 1 Then

   ' Create New Workbook to hold all data from analyses
     With xlsApp
      xlsApp.Visible = True
      xlsApp.DisplayAlerts = False
      xlsApp.Workbooks.Add
     End With
   xlsApp.Range("A1").Select
   xlsApp.Selection.pastespecial 12

 DataAn = Rot3 & "_" & MosCalc & "_ClipMosaic" & ".txt"

   xlsApp.Windows(DataAn).Activate
   xlsApp.ActiveWindow.Close
   xlsApp.Range("A5:IC6").Select
   xlsApp.Selection.Copy
   xlsApp.Range("T1").Select
   xlsApp.Selection.pastespecial 12
   xlsApp.Rows("4:6").Select
   xlsApp.Selection.Delete Up
   xlsApp.ActiveWindow.Close True,filenameJC
   xlsApp.Quit
Else

   ' Open Workbook to add data from analyses
    With xlsApp
     xlsApp.Visible = True
     xlsApp.DisplayAlerts = False
     xlsApp.Workbooks.Open filenameJC
    End With
   xlsApp.Range("A200").Select
   xlsApp.Selection.pastespecial 12

 DataAn = Rot3 & "_" & MosCalc & "_ClipMosaic" & ".txt"

   xlsApp.Windows(DataAn).Activate
   xlsApp.ActiveWindow.Close
   xlsApp.Range("A205:IC205").Select
   xlsApp.Selection.Copy
   xlsApp.Range("T201").Select
   xlsApp.Selection.pastespecial 12
   xlsApp.Range("A201:IV201").Select
   xlsApp.Selection.Copy
   xlsApp.Rows("2").Select
   xlsApp.Selection.Insert
   xlsApp.Rows("200:206").Select
   xlsApp.Selection.Delete Up
   xlsApp.Range("A1").Select
   xlsApp.ActiveWindow.Close True,filenameJC
   xlsApp.Quit
 End If
 Else

    ' Open Workbook to add data from analyses
    With xlsApp
     xlsApp.Visible = True
     xlsApp.DisplayAlerts = False
     xlsApp.Workbooks.Open filenameJC
    End With
   xlsApp.Range("A200").Select
   xlsApp.Selection.pastespecial 12

 DataAn = Rot3 & "_" & MosCalc & "_ClipMosaic" & ".txt"

   xlsApp.Windows(DataAn).Activate
   xlsApp.ActiveWindow.Close
   xlsApp.Range("A205:IC205").Select
   xlsApp.Selection.Copy
   xlsApp.Range("T201").Select
   xlsApp.Selection.pastespecial 12
   xlsApp.Range("A201:IV201").Select
   xlsApp.Selection.Copy
   xlsApp.Rows("2").Select
   xlsApp.Selection.Insert
   xlsApp.Rows("200:206").Select
   xlsApp.Selection.Delete Up
   xlsApp.Range("A1").Select
   xlsApp.ActiveWindow.Close True,filenameJC
   xlsApp.Quit
 End If
xlsApp.Quit
Next
Next


' Open Workbook to calculate overall results
Set xlsApp = CreateObject("Excel.Application")
 With xlsApp
  xlsApp.Visible = True
  xlsApp.DisplayAlerts = False
  xlsApp.Workbooks.Open filenameJC
 End With
 xlsApp.Rows("2:3").Insert
 xlsApp.Range("A2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=SUM(R[2]C:R[38]C)"
 xlsApp.Range("A3").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=AVERAGE(R[1]C:R[37]C)"
 xlsApp.Range("A2").Select
 xlsApp.Selection.Copy
 xlsApp.Range("B2:C2").Select
 xlsApp.ActiveSheet.Paste
 xlsApp.Range("I2:J2").Select
 xlsApp.ActiveSheet.Paste
 xlsApp.Range("T2:IV2").Select
 xlsApp.ActiveSheet.Paste
 xlsApp.Range("K2").Select
 xlsApp.ActiveCell.FormulaR1C1 = Resolution

'dude

' Calculate overall Percent Air
 xlsApp.Range("E2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=100*(RC[-4]/RC[-2])"

 ' Calculate overall Percent Not Air
 xlsApp.Range("F2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=100*(RC[-4]/RC[-3])"

 ' Sum above 2 values to verify they combine to 100%
 xlsApp.Range("G2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=SUM(RC[-2]:RC[-1])"

' Calculate (from Air % Value and Batch Weights) or Display (from input) Paste Percentage In Mix
If Datachunk = "pa" Then
   xlsApp.Range("S2").Select
   xlsApp.ActiveCell.FormulaR1C1 = PasteAggRatio
xlsApp.Range("N2").Select
   xlsApp.ActiveCell.FormulaR1C1 = "=(100-RC[-9])*((100*(RC[5]/(1+RC[5])))/100)"
Else
If Datachunk = "manualcount" Then
xlsApp.Range("S2").Select
   xlsApp.ActiveCell.FormulaR1C1 = NotAggPct
xlsApp.Range("N2").Select
   xlsApp.ActiveCell.FormulaR1C1 = "=RC[5]-RC[-9]"
Else
If Datachunk = "pp" Then
   xlsApp.Range("N2").Select
   xlsApp.ActiveCell.FormulaR1C1 = Paste
 Else
If Datachunk = "ap" Then
   xlsApp.Range("S2").Select
   xlsApp.ActiveCell.FormulaR1C1 = NotAggPct
xlsApp.Range("N2").Select
   xlsApp.ActiveCell.FormulaR1C1 = "=RC[5]-RC[-9]"
End If
End If
End If
End If

 xlsApp.Range("N1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Paste %"

 ' Calculate overall Paste/Air Ratio
 xlsApp.Range("O2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=RC[-1]/RC[-10]"
 xlsApp.Range("O1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Paste/air"

 ' Calculate Total Length of Traverse Line
 xlsApp.Range("L2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=RC[-2]*RC[-1]*(10^-6)*(10^3)"
 xlsApp.Range("L1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Trav.(mm)"

 ' Calculate Number of Intercepts (voids) per mm of traverse line
 xlsApp.Range("M2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=RC[-4]/RC[-1]"
 xlsApp.Range("M1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Voids/mm"

' Calculate overall Average Chord Length
 xlsApp.Range("P2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=RC[-11]/(100*RC[-3])"
 xlsApp.Range("P1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Chord L"

 ' Calculate overall Specific Surface Value
 xlsApp.Range("Q2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=(4/RC[-1])"
 xlsApp.Range("Q1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Sp.Surf"

 ' Calculate overall Spacing Factor
 xlsApp.Range("R2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=IF(RC[-3]<=4.342,RC[-4]/(400*RC[-5]),(3/RC[-1])*((1.4*((1+RC[-3])^(1/3)))-1))"
 xlsApp.Range("R1").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Sp.factor"

 xlsApp.Range("A3").Select
 xlsApp.Selection.Copy
 xlsApp.Range("B3:IV3").Select
 xlsApp.ActiveSheet.Paste
 xlsApp.Range("H2:H3").Select
 xlsApp.Selection.ClearContents
 xlsApp.Range("D2:D3").Select
 xlsApp.Selection.ClearContents
 xlsApp.Range("S3").Select
 xlsApp.Selection.ClearContents
 
 xlsApp.Range("A2:IV3").Select
 xlsApp.Selection.Copy
 xlsApp.Selection.PasteSpecial 12
 
 xlsApp.Range("T1:IV40").Select
 xlsApp.Selection.Copy
 xlsApp.Range("B41").Select
 xlsApp.Selection.PasteSpecial 12
 xlsApp.Range("A41").Select
 xlsApp.ActiveCell.FormulaR1C1 = "0"
 xlsApp.Range("A42").Select
 xlsApp.ActiveCell.FormulaR1C1 = "0"
 xlsApp.Range("T1:IV40").Select
 xlsApp.Selection.ClearContents
 xlsApp.Range("A2:R2").Select
 xlsApp.Selection.Copy


'compile results
xlsApp.Workbooks.Open OptThreshFile
LocationA = "A" & BatchNum + 1
LocationB = "B" & BatchNum + 1
LocationC = "S" & BatchNum + 1
LocationD = LocationB & ":" & LocationC
LocationE = "T" & BatchNum + 1
LocationF = "U" & BatchNum + 1
LocationG = "V" & BatchNum + 1
LocationH = "W" & BatchNum + 1

xlsApp.Range(LocationA).Select
xlsApp.ActiveCell.FormulaR1C1 = Defaultfile
xlsApp.Range(LocationD).Select
xlsApp.Selection.PasteSpecial 12
xlsApp.ActiveWorkbook.Close True
xlsApp.ActiveWorkbook.Close True
xlsApp.Quit
Loop