'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 = True
  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
Set xlsApp = Createobject("Excel.Application")
  With xlsApp
   xlsApp.Visible = False
   xlsApp.Workbooks.Open BatchFile
  End With
	Defaultfile = xlsApp.Range(Cell)
	xlsApp.Range(Cell).Select
	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 = "concrete"
SampleID = Defaultfile
TestLab = "MDOT C&T"
Nerd1 = "John Staton"
Nerd2 = "Samara Sears-Bartz"
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


THold = ThreshValue

' 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)
   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)
  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

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 = 1

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 = Path3 & SaveFileName & ThreshValue & ".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("A1").Select

 ' Creat Excel Chart of Chord Length (microns) vs. Number of Chords
 xlsApp.Charts.Add
 With xlsApp.ActiveChart
 	.ChartType =-4169
 	.PlotBy =1
 	.Name = "ChordChart"
 	.HasLegend =False
 	.HasTitle =True
 	.ChartTitle.Characters.Text = "Distribution of Air-Void Chord Lengths"
  	.Axes(1,1).HasTitle =True
 	.Axes(1,1).AxisTitle.Characters.Text = "Chord Length (microns)"
 	.Axes(2,1).HasTitle =True
 	.Axes(2,1).AxisTitle.Characters.Text = "Number of Chords"
 	.SeriesCollection(1).XValues = "=Sheet1!R41"
 	.SeriesCollection(1).Values = "=Sheet1!R42"
 End With
 
 ' Set Limits of X-Axis of Chart
 xlsApp.ActiveChart.Axes(1).Select
 With xlsApp.ActiveChart.Axes(1)
 	.MinimumScaleIsAuto =True
 	.MaximumScale = 500
 	.MinorUnitIsAuto =True
 	.MajorUnitIsAuto =True
 End With
 
 ' Format Chart Area Color From Default Gray to White
 xlsApp.ActiveChart.PlotArea.Select
 xlsApp.Selection.Interior.ColorIndex =None
 
 ' Format Chart Title Text
 xlsApp.ActiveChart.ChartTitle.Select
 xlsApp.Selection.AutoScaleFont =True
 With xlsApp.Selection.Font
 	.Name ="Arial"
 	.FontStyle ="Bold"
 	.Size =20
 End With
 
 ' Format X-Axis Text
 xlsApp.ActiveChart.Axes(1).AxisTitle.Select
 xlsApp.Selection.AutoScaleFont =True
 With xlsApp.Selection.Font
 	.Name ="Arial"
 	.FontStyle = "Bold"
 	.Size =14
 End with
 
 ' Format Ysel-Axis Text
 xlsApp.ActiveChart.Axes(2).AxisTitle.Select
 xlsApp.Selection.AutoScaleFont =True
 With xlsApp.Selection.Font
 	.Name ="Arial"
 	.FontStyle = "Bold"
 	.Size =14
 End with

 ' Create New Sheet which will serve as "Page 1" of Final Report
 xlsApp.Sheets.Add
 With xlsApp.ActiveSheet
 	.Name = "Pg1"
 End With
 xlsApp.Range("1:1,4:46").Select
 xlsApp.Selection.RowHeight = 15.75
 xlsApp.Range("B2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Air Void Analysis of Hardened Concrete"
 xlsApp.Range("B3").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Calculated According to ASTM C 457"
 
 ' Insert Scanned Report Image into "Page 1"
 
 xlsApp.Range("B6").Select
 xlsApp.ActiveSheet.Pictures.Insert(fileNameR).Select 

     
' Insert Threshold Scanned Report Image into "Page 1"

Set ReportDoc = appRef1.Open(fileNameR)
ReportDoc.ResizeCanvas ThumbNailx,ThumbNaily
ReportDoc.ActiveLayer.Threshold THold
ReportDoc.ActiveLayer.Invert
ReportDoc.ResizeCanvas 300,586
fileNameRb = "Thresh_Report.jpg"
fileNameRR = Path1 & fileNameRb
ReportDoc.SaveAs fileNameRR, jpgSaveOptions, True, extType
ReportDoc.close ( 2) 


xlsApp.Range("E6").Select
 xlsApp.ActiveSheet.Pictures.Insert(fileNameRR).Select  

 
' Enter "Page 1" Data Descriptors
 xlsApp.Range("B34").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Sample #:"
 xlsApp.Range("B35").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Project ID:"
 xlsApp.Range("B36").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Originator:"
 xlsApp.Range("B37").Select
 xlsApp.ActiveCell.FormulaR1C1 = "File Name:"
 xlsApp.Range("E34").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Date:"
 xlsApp.Range("E35").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Test Lab:"
 xlsApp.Range("E36").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Operator:"
 
 ' Display current Date/Time and Previously Input Data
 xlsApp.Range("F34:G34").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=NOW()"
 xlsApp.Selection.NumberFormat = "[$-409]m/d/yy h:mm AM/PM;@"
  With xlsApp.Selection
 	.HorizontalAlignment = -4131
 
 End with
 xlsApp.Range("C34:D34").Select
 xlsApp.ActiveCell.FormulaR1C1 = SampleID
 xlsApp.Range("C35:D35").Select
 xlsApp.ActiveCell.FormulaR1C1 = ProjID
 xlsApp.Range("F35:G35").Select
 xlsApp.ActiveCell.FormulaR1C1 = TestLab
 xlsApp.Range("C36:D36").Select
 xlsApp.ActiveCell.FormulaR1C1 = Nerd1
 xlsApp.Range("F36:G36").Select
 xlsApp.ActiveCell.FormulaR1C1 = Nerd2
 xlsApp.Range("C37:D37").Select
 xlsApp.ActiveCell.FormulaR1C1 = fileName
 
 ' Merge Cells and Create Borders for "Page 1" Formatting
 xlsApp.Range("B2:G2").Select
     With xlsApp.Selection
         .HorizontalAlignment = -4108
     End With
 xlsApp.Selection.Merge
     With xlsApp.Selection.Font
         .Name = "Arial"
         .Size = 18
 	.Bold = True
     End With
 xlsApp.Range("B3:G3").Select
     With xlsApp.Selection
         .HorizontalAlignment = -4108
     End With
 xlsApp.Selection.Merge
     With xlsApp.Selection.Font
         .Name = "Arial"
         .Size = 14
 	.Bold = True
     End With
 xlsApp.Range("B2:G4").Select
 xlsApp.Selection.Borders(5).LineStyle = -4142
 xlsApp.Selection.Borders(6).LineStyle = -4142
     With xlsApp.Selection.Borders(7)
         .LineStyle = 1
         .Weight = 2
         .ColorIndex = -4105
     End With
     With xlsApp.Selection.Borders(8)
         .LineStyle = 1
         .Weight = 2
         .ColorIndex = -4105
     End With
     With xlsApp.Selection.Borders(9)
         .LineStyle = 1
         .Weight = 2
         .ColorIndex = -4105
     End With
     With xlsApp.Selection.Borders(10)
         .LineStyle = 1
         .Weight = 2
         .ColorIndex = -4105
     End With
 xlsApp.Selection.Borders(11).LineStyle = -4142
 xlsApp.Selection.Borders(12).LineStyle = -4142
 xlsApp.Range("B34:B37").Select
 xlsApp.Selection.Font.Bold = True
    With xlsApp.Selection.Font
         .Name = "Arial"
         .Size = 10
    End With
 xlsApp.Range("E34:E38").Select
 xlsApp.Selection.Font.Bold = True
    With xlsApp.Selection.Font
         .Name = "Arial"
         .Size = 10
    End With
 xlsApp.Range("C34:D34").Select
 xlsApp.Selection.Merge
 xlsApp.Range("C35:D35").Select
 xlsApp.Selection.Merge
 xlsApp.Range("C36:D36").Select
 xlsApp.Selection.Merge
 xlsApp.Range("C37:D37").Select
 xlsApp.Selection.Merge
 xlsApp.Range("F34:G34").Select
 xlsApp.Selection.Merge
 xlsApp.Range("F35:G35").Select
 xlsApp.Selection.Merge
 xlsApp.Range("F36:G36").Select
 xlsApp.Selection.Merge
 xlsApp.Range("F37:G37").Select
 xlsApp.Selection.Merge
 xlsApp.Range("B33:G38").Select
 xlsApp.Selection.Borders(5).LineStyle = -4142
 xlsApp.Selection.Borders(6).LineStyle = -4142
 xlsApp.Selection.Borders(7).LineStyle = -4142
    With xlsApp.Selection.Borders(8)
         .LineStyle = 1
         .Weight = 2
         .ColorIndex = -4105
    End With
    With xlsApp.Selection.Borders(9)
         .LineStyle = 1
         .Weight = 2
         .ColorIndex = -4105
    End With
 xlsApp.Selection.Borders(10).LineStyle = -4142
 xlsApp.Selection.Borders(11).LineStyle = -4142
 xlsApp.Selection.Borders(12).LineStyle = -4142
 
 ' Insert Testing Organization's Logo into "Page 1"
 xlsApp.Range("C40").Select
 xlsApp.ActiveSheet.Pictures.Insert(Ipath).Select
 xlsApp.Range("C34:D37,F34:G37").Select
 xlsApp.Range("F34").Activate
    With xlsApp.Selection
         .VerticalAlignment = -4108
    End With
 
 ' Enter Captions for Report Photos in "Page 1"
 xlsApp.Range("B22:D22").Select
     With xlsApp.Selection
         .HorizontalAlignment = -4108
     End With
 xlsApp.Selection.Merge
 xlsApp.Selection.Font.ColorIndex = 48
 xlsApp.ActiveCell.FormulaR1C1 = "Scanned Black and White Image"
 xlsApp.Range("E22:G22").Select
     With xlsApp.Selection
         .HorizontalAlignment = -4108
     End With
 xlsApp.Selection.Merge
 xlsApp.Selection.Font.ColorIndex = 48
 xlsApp.ActiveCell.FormulaR1C1 = "Scanned Image After Thresholding"
 
 ' Enter Image Characteristics (Sizes)

 xlsApp.Range("J14").Select
 xlsApp.ActiveCell.FormulaR1C1 = Round(Xsel*(Resolution/1000),0)
 xlsApp.Range("J15").Select
 xlsApp.ActiveCell.FormulaR1C1 = Round(Ysel*(Resolution/1000),0)
 
 xlsApp.Rows("24").Select
 xlsApp.Selection.Delete Up
 xlsApp.Rows("24").Insert
 xlsApp.Selection.Insert Down
 
 xlsApp.Range("B24:C24").Select
     With xlsApp.Selection
         .HorizontalAlignment = -4108
     End With
 xlsApp.Selection.Merge
 xlsApp.ActiveCell.FormulaR1C1 = "Area Analyzed (mm x mm)"
 xlsApp.Range("D24").Select
     With xlsApp.Selection
         .HorizontalAlignment = -4108
     End With
 xlsApp.ActiveCell.FormulaR1C1 = "=CONCATENATE(R[-10]C[6],"" x "",R[-9]C[6])"
 
 ' Adjust Data Locations to Best Present Data on "Page 1"

xlsApp.Columns("B:B").Select
 xlsApp.Selection.ColumnWidth = 14.5
 xlsApp.Columns("C:G").Select
 xlsApp.Selection.ColumnWidth = 13
 xlsApp.Range("B22:D22").Select
 xlsApp.Selection.Cut
 xlsApp.Range("B23").Select
 xlsApp.ActiveSheet.Paste
 xlsApp.Range("E22:G22").Select
 xlsApp.Selection.Cut
 xlsApp.Range("E23").Select
 xlsApp.ActiveSheet.Paste
 xlsApp.Rows("37:37").Select
 xlsApp.Selection.Insert Down
 xlsApp.Range("B38:D38").Select
 xlsApp.Selection.Cut
 xlsApp.Range("B37").Select
 xlsApp.ActiveSheet.Paste
 xlsApp.Range("E38:G38").Select
 xlsApp.Selection.Cut
 xlsApp.Range("B38").Select
 xlsApp.ActiveSheet.Paste
 xlsApp.Range("C39:G39").Select
     With xlsApp.Selection
         .MergeCells = True
     End With
 xlsApp.Range("E37").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Threshold:"
 xlsApp.Range("F37").Select
 xlsApp.ActiveCell.FormulaR1C1 = THold
 xlsApp.Range("C35:D38,F35:G38,C39:G39").Select
     With xlsApp.Selection
         .HorizontalAlignment = -4131
     End With
 xlsApp.Range("E37").Select
 xlsApp.Selection.Font.Bold = True
    With xlsApp.Selection.Font
         .Name = "Arial"
         .Size = 10
    End With
 xlsApp.ActiveSheet.Shapes("Picture 1").Select
 xlsApp.Selection.ShapeRange.IncrementLeft 33.75
 xlsApp.ActiveSheet.Shapes("Picture 2").Select
 xlsApp.Selection.ShapeRange.IncrementLeft 33.75 
 
 ' Set up Page 2 of Report in Excel
 xlsApp.Sheets("Pg1").Select
 xlsApp.Range("B2:G45").Select
 xlsApp.Selection.Copy
 xlsApp.Sheets.Add
 With xlsApp.ActiveSheet
 	.Name = "Pg2"
 End With
 xlsApp.Sheets("Pg2").Select
 xlsApp.Range("B2").Select
 xlsApp.ActiveSheet.Paste
 xlsApp.Range("B3:G3").Select
 xlsApp.ActiveCell.FormulaR1C1 = "Calculated According to Procedure A"
     xlsApp.ActiveSheet.Shapes("Picture 2").Select
     xlsApp.Selection.Delete
     xlsApp.ActiveSheet.Shapes("Picture 1").Select
     xlsApp.Selection.Delete
 xlsApp.Range("B6:G29").Select
 xlsApp.Selection.ClearContents
 
 xlsApp.Range("B7:D7").Select
     With xlsApp.Selection
         .HorizontalAlignment = -4131
     End With
 xlsApp.Selection.Merge
 xlsApp.ActiveCell.FormulaR1C1 = "# of Pixels in Traverse Line:"
 
 xlsApp.Range("B8:D8").Select
     With xlsApp.Selection
         .HorizontalAlignment = -4131
     End With
 xlsApp.Selection.Merge
 xlsApp.ActiveCell.FormulaR1C1 = "Resolution (microns/pixel):"
 
 xlsApp.Range("B9:D9").Select
     With xlsApp.Selection
         .HorizontalAlignment = -4131
     End With
 xlsApp.Selection.Merge
 xlsApp.ActiveCell.FormulaR1C1 = "Length of Traverse (mm):"
 
 xlsApp.Range("B11:D11").Select
     With xlsApp.Selection
         .HorizontalAlignment = -4131
     End With
 xlsApp.Selection.Merge
 xlsApp.ActiveCell.FormulaR1C1 = "# of Air Pixels:"
 
 xlsApp.Range("B12:D12").Select
     With xlsApp.Selection
         .HorizontalAlignment = -4131
     End With
 xlsApp.Selection.Merge
 xlsApp.ActiveCell.FormulaR1C1 = "# of Non-air Pixels:"
 
 xlsApp.Range("B13:D13").Select
     With xlsApp.Selection
         .HorizontalAlignment = -4131
     End With
 xlsApp.Selection.Merge
 xlsApp.ActiveCell.FormulaR1C1 = "# of Air Void Chord Intercepts:"
 
 xlsApp.Range("B15:D15").Select
     With xlsApp.Selection
         .HorizontalAlignment = -4131
     End With
 xlsApp.Selection.Merge
 xlsApp.ActiveCell.FormulaR1C1 = "Calculated Air Content (%):"
 
 xlsApp.Range("B16:D16").Select
     With xlsApp.Selection
         .HorizontalAlignment = -4131
     End With
 xlsApp.Selection.Merge


 xlsApp.ActiveCell.FormulaR1C1 = "Paste Content (%):"
 

 xlsApp.Range("B17:D17").Select
     With xlsApp.Selection
         .HorizontalAlignment = -4131
     End With
 xlsApp.Selection.Merge
 xlsApp.ActiveCell.FormulaR1C1 = "Paste/Air Ratio:"
 
 xlsApp.Range("B18:D18").Select
     With xlsApp.Selection
         .HorizontalAlignment = -4131
     End With
 xlsApp.Selection.Merge
 xlsApp.ActiveCell.FormulaR1C1 = "Void Frequency (Voids/mm):"
 
 xlsApp.Range("B19:D19").Select
     With xlsApp.Selection
         .HorizontalAlignment = -4131
     End With
 xlsApp.Selection.Merge
 xlsApp.ActiveCell.FormulaR1C1 = "Specific Surface (mm2/mm3):"
 
 xlsApp.Range("B20:D20").Select
     With xlsApp.Selection
         .HorizontalAlignment = -4131
     End With
 xlsApp.Selection.Merge
 xlsApp.ActiveCell.FormulaR1C1 = "Powers Spacing Factor (mm):"
 
 xlsApp.Range("B6:G31").Select
     With xlsApp.Selection
         .VerticalAlignment = -4108
     End With
 
 xlsApp.Range("B7:D23").Select
     With xlsApp.Selection.Font
         .Name = "Arial"
         .Size = 12
     End With
 xlsApp.Selection.Font.Bold = True
 
 Mossheet = "Sheet1"

 xlsApp.Sheets(Mossheet).Select
 xlsApp.Range("K2").Select
 xlsApp.Selection.Copy
 xlsApp.Sheets("Pg2").Select
 xlsApp.Range("E8").Select
 xlsApp.ActiveSheet.Paste
 xlsApp.Range("L8").Select
 xlsApp.ActiveSheet.Paste
 
 xlsApp.Sheets(Mossheet).Select
 xlsApp.Range("C2").Select
 xlsApp.Selection.Copy
 xlsApp.Sheets("Pg2").Select
 xlsApp.Range("E7").Select
 xlsApp.ActiveSheet.Paste
 
 xlsApp.Sheets(Mossheet).Select
 xlsApp.Range("L2").Select
 xlsApp.Selection.Copy
 xlsApp.Sheets("Pg2").Select
 xlsApp.Range("E9").Select
 xlsApp.ActiveSheet.Paste
 
 xlsApp.Sheets(Mossheet).Select
 xlsApp.Range("A2").Select
 xlsApp.Selection.Copy
 xlsApp.Sheets("Pg2").Select
 xlsApp.Range("E11").Select
 xlsApp.ActiveSheet.Paste
 
 xlsApp.Sheets(Mossheet).Select
 xlsApp.Range("B2").Select
 xlsApp.Selection.Copy
 xlsApp.Sheets("Pg2").Select
 xlsApp.Range("E12").Select
 xlsApp.ActiveSheet.Paste
 
 xlsApp.Sheets(Mossheet).Select
 xlsApp.Range("I2").Select
 xlsApp.Selection.Copy
 xlsApp.Sheets("Pg2").Select
 xlsApp.Range("E13").Select
 xlsApp.ActiveSheet.Paste
 
 xlsApp.Sheets(Mossheet).Select
 xlsApp.Range("E2").Select
 xlsApp.Selection.Copy
 xlsApp.Sheets("Pg2").Select
 xlsApp.Range("E15").Select
 xlsApp.ActiveSheet.Paste
 
 xlsApp.Sheets(Mossheet).Select
 xlsApp.Range("N2").Select
 xlsApp.Selection.Copy
 xlsApp.Sheets("Pg2").Select
 xlsApp.Range("E16").Select
 xlsApp.ActiveSheet.Paste
 
 xlsApp.Sheets(Mossheet).Select
 xlsApp.Range("O2").Select
 xlsApp.Selection.Copy
 xlsApp.Sheets("Pg2").Select
 xlsApp.Range("E17").Select
 xlsApp.ActiveSheet.Paste
 
 xlsApp.Sheets(Mossheet).Select
 xlsApp.Range("M2").Select
 xlsApp.Selection.Copy
 xlsApp.Sheets("Pg2").Select
 xlsApp.Range("E18").Select
 xlsApp.ActiveSheet.Paste
 
 xlsApp.Sheets(Mossheet).Select
 xlsApp.Range("Q2").Select
 xlsApp.Selection.Copy
 xlsApp.Sheets("Pg2").Select
 xlsApp.Range("E19").Select
 xlsApp.ActiveSheet.Paste
 
 xlsApp.Sheets(Mossheet).Select
 xlsApp.Range("R2").Select
 xlsApp.Selection.Copy
 xlsApp.Sheets("Pg2").Select
 xlsApp.Range("E20").Select
 xlsApp.ActiveSheet.Paste
 
 xlsApp.Range("E7:F20").Select
     With xlsApp.Selection
         .VerticalAlignment = -4108
     End With
 
 xlsApp.Range("E7:E8,E11:E13,F7:F8").Select
 xlsApp.Selection.NumberFormat = "0"
 
 xlsApp.Range("E9,F9").Select
 xlsApp.Selection.NumberFormat = "0.0"

 xlsApp.Range("F11:F13").Select
 xlsApp.Selection.NumberFormat = "0"
 
 xlsApp.Range("E15:E20,F15:F20").Select
 xlsApp.Selection.NumberFormat = "0.000"

 xlsApp.Range("F15,F17:F20").Select
 xlsApp.Selection.NumberFormat = "0.000"

 xlsApp.Range("E6").Select
     With xlsApp.Selection
         .HorizontalAlignment = -4108
     End With
 xlsApp.ActiveCell.FormulaR1C1 = "Results"
  xlsApp.Range("E6:F6").Select
     With xlsApp.Selection.Font
         .Name = "Arial"
         .Size = 12
     End With
 xlsApp.Selection.Font.Bold = True
 
 ' Copy Data From "Page 1" to move to Word Document
 xlsApp.Sheets("Pg1").Select
 xlsApp.Range("1:1,4:4,5:45").Select
 xlsApp.Selection.RowHeight = 15.75
 xlsApp.Range("6:6").Select
 xlsApp.Selection.RowHeight = 40.00
 xlsApp.Columns("B:B").Select
 xlsApp.Selection.ColumnWidth = 14.5
 xlsApp.Columns("C:G").Select
 xlsApp.Selection.ColumnWidth = 13
 xlsApp.Rows("25:32").Select
 xlsApp.Selection.Delete Up

 xlsApp.Range("E30").Select
     With xlsApp.Selection.Font
         .Name = "Arial"
         .Size = 10
     End With
 xlsApp.Selection.Font.Bold = True
 xlsApp.ActiveCell.FormulaR1C1 = "# Iterations:"
 xlsApp.Range("F30").Select
     With xlsApp.Selection
         .VerticalAlignment = -4108
     End With
 xlsApp.ActiveCell.FormulaR1C1 = NumIts

 xlsApp.Range("B1:G36").Select
 xlsApp.Selection.Copy
 
 ' Define Applications to Be Used In Script
 Set appRef3 = CreateObject( "Word.Application" )
   With appRef3
    appRef3.Visible = True
   End With
 
 ' Create MSWord file to Summarize Data
 fileName7 = SaveFileName  
 Set wordsum = appRef3.Documents.Add
 Set AAA = appRef3.Selection
 
 ' Paste "Page 1" Data from Excel into word
 AAA.PasteandFormat 0
 AAA.InsertBreak 7
 
 ' Copy Data From "Page 2" to move to Word Document
 xlsApp.Sheets("Pg2").Select
 xlsApp.Range("1:1,4:4,5:45").Select
 xlsApp.Selection.RowHeight = 15.75
 xlsApp.Range("6:6").Select
 xlsApp.Selection.RowHeight = 40.00
 xlsApp.Columns("B:B").Select
 xlsApp.Selection.ColumnWidth = 14.5
 xlsApp.Columns("C:G").Select
 xlsApp.Selection.ColumnWidth = 13
 xlsApp.Rows("25:31").Select
 xlsApp.Selection.Delete Up

 xlsApp.Range("E31").Select
     With xlsApp.Selection.Font
         .Name = "Arial"
         .Size = 10
     End With
 xlsApp.Selection.Font.Bold = True
 xlsApp.ActiveCell.FormulaR1C1 = "# Iterations:"
 xlsApp.Range("F31").Select
     With xlsApp.Selection
         .VerticalAlignment = -4108
     End With
 xlsApp.ActiveCell.FormulaR1C1 = NumIts

 xlsApp.Range("B6:D20").Select
     With xlsApp.Selection
         .HorizontalAlignment = -4152
     End With

 xlsApp.Range("B1:G37").Select
 xlsApp.Selection.Copy
 
 AAA.PasteandFormat 0
 
 ' Enter Data into Word Document Footer
 appRef3.ActiveWindow.ActivePane.View.SeekView = 10
 AAA.TypeText "Pg. "
 AAA.Fields.Add AAA.Range, 33
 AAA.TypeText " of "
 AAA.Fields.Add AAA.Range, 26
 AAA.TypeText vbTab & "ASTM C457 Air Calculation of BW Image"
 appRef3.ActiveWindow.ActivePane.View.SeekView = 0
 
 xlsApp.Sheets("ChordChart").Select
 xlsApp.ActiveChart.ChartArea.Select
 xlsApp.ActiveChart.ChartArea.Copy
 
 AAA.ParagraphFormat.Alignment = 1
 AAA.Font.Bold = 9999998
 AAA.TypeText "Air Void System - Graphical Analysis"
 AAA.TypeParagraph
 AAA.Font.Bold = 9999998
 AAA.TypeParagraph
 AAA.PasteAndFormat 13
 AAA.TypeParagraph
 AAA.TypeParagraph
 AAA.TypeParagraph
 AAA.TypeParagraph
 AAA.TypeParagraph
 AAA.TypeText "Comments...."
 AAA.TypeParagraph
 AAA.TypeParagraph
If ChordAnalysis = 0 Then
AAA.TypeText "Air void chord length distribution omitted."
End If
 AAA.TypeParagraph
 AAA.Font.Bold = 9999998
 AAA.TypeText "________________________________________________________________________"
 AAA.TypeParagraph
 AAA.TypeParagraph
 AAA.TypeText "________________________________________________________________________"
 AAA.TypeParagraph
 AAA.TypeParagraph
 AAA.TypeText "________________________________________________________________________"
 AAA.TypeParagraph
 AAA.TypeParagraph
 AAA.TypeText "________________________________________________________________________"
 AAA.TypeParagraph
 AAA.TypeParagraph
 AAA.TypeText "________________________________________________________________________"
 AAA.TypeParagraph
 AAA.TypeParagraph
 AAA.TypeText "________________________________________________________________________"
 AAA.TypeParagraph
 AAA.TypeParagraph
 AAA.TypeText "________________________________________________________________________"
  
 ' Save Word file
 fileName9 = Path3 & fileName7 & ThreshValue & ".doc"
 wordsum.SaveAs fileName9

 xlsApp.ActiveWorkBook.Close True
 xlsApp.Quit
 appRef3.Quit


Loop