'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
'*******************************************************************************************
'*******************************************************************************************
'*******************************************************************************************
'*******************************************************************************************
' 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 Default Filename
DefaultfileText1 = "Enter B/W filename to be analyzed without the *.tif extension:"
DefaultfileText2 = "Enter B/W filename to be analyzed"
DefaultfileText3 = "Tester"
Defaultfile = InputBox(DefaultfileText1,DefaultfileText2,DefaultfileText3,XBox,YBox)
'*******************************************************************************************
' Input Characteristics of Sample, Technicians and Testing Lab
ProjID = InputBox("Enter Project Identification: ","Project Identification Entry","Concrete",XBox,YBox)
SampleID = InputBox("Enter Sample Identification: ","Sample Identification Entry",Defaultfile,XBox,YBox)
TestLab = InputBox("Enter Name of Test Lab Performing Test: ","Test Lab Identificataion","MDOT C&T",XBox,YBox)
Nerd1 = InputBox("Enter Name of Person Initiating Test: ","Initiatiator of Test","John Staton",XBox,YBox)
Nerd2 = InputBox("Enter Name of Technician Running Test: ","Technician ID Entry","Samara Sears-Bartz",XBox,YBox)
SaveFileName = InputBox("Enter Name for Excel and Word Summary files to be saved as in Results folder: ","Results File Names",Defaultfile,XBox,YBox)

 AggTop = InputBox("Enter Top Size of Aggregate in Concrete (in inches):","AggTop",0.375,XBox,YBox)
NumberRotations = 1
'FilterYN = Msgbox("Should Digital Imaging Filters be used?",36,"Use of Digital Imaging Filters?")
FilterYN = 2
'*******************************************************************************************
' Input Characteristics of Concrete Mix Design from Batch Weights or previous knowledge
SGValue = Msgbox("Are either the sample's batch weights or percent paste known?",36,"Sample Data Known?")
If SGValue = 7 Then
 PtCnt = Msgbox("Should a point count be performed to determine the percent paste?",36,"Paste point count?")
 If PtCnt  = 7 Then
  Msgbox "Without knowing either the batch weights or the percent paste, this program can not perform the test.  This program will now quit."
  Wscript.Quit
 Else
  PastePointCount = 23
 End If
Else
End If

If PastePointCount = 23 Then
 DefaultfileText1 = "Enter RGB Filename to be point counted without the *.tif extension:"
 DefaultfileText2 = "Enter Filename to be point counted"
 DefaultfileText3 = "Tester_RGB"
 DefaultfileRGB = InputBox(DefaultfileText1,DefaultfileText2,DefaultfileText3,XBox,YBox)
Else
 Data = Inputbox("Would you like to enter in mix design info to determine the percent paste in the specimen, or would you rather enter in a value for either paste vol% or aggregate vol%? (mi/pp/ap):","Enter Mix Info or Paste %?","mi",XBox,YBox)
 If Data = "mi" Then
 Datachunk = Inputbox("Would you like to enter in batch weight info, or the paste/agg volume ratio? (bw/pa):","Enter Batch Weights or paste/agg?","pa",XBox,YBox) 
If Datachunk = "pa" Then
 PasteAggRatio = InputBox("Enter paste/agg volume ratio:","Paste/agg volume ratio Input",0.48,XBox,YBox)
 
Else
Datachunk = "pa"  
NumAggs = InputBox("Enter Number of Aggregate Gradations used in mix: (ex: 2 Coarse Aggregates + 1 Fine Aggregate = 3 Total Aggregates)","Number Aggregate Gradations Used Input",3,XBox,YBox)
   If NumAggs = 1 Then
    Agg1LB = InputBox("Enter Batch Weight of Aggregate 1 (in pounds):","Agg1LB",3000,XBox,YBox)
    Agg1SG = InputBox("Enter Specific Gravity Value for Aggregate 1:","Agg1SG",2.70,XBox,YBox)
    Agg1V = Agg1LB/(Agg1SG*62.4)
    TotAggV = Agg1V
   ElseIf NumAggs = 2 Then
    Agg1LB = InputBox("Enter Batch Weight of Aggregate 1 (in pounds):","Agg1LB",1800,XBox,YBox)
    Agg1SG = InputBox("Enter Specific Gravity Value for Aggregate 1:","Agg1SG",2.70,XBox,YBox)
    Agg1V = Agg1LB/(Agg1SG*62.4)
    Agg2LB = InputBox("Enter Batch Weight of Aggregate 2 (in pounds):","Agg2LB",1200,XBox,YBox)
    Agg2SG = InputBox("Enter Specific Gravity Value for Aggregate 2:","Agg2SG",2.70,XBox,YBox)
    Agg2V = Agg2LB/(Agg2SG*62.4)
    TotAggV = Agg1V + Agg2V
   ElseIf NumAggs = 3 Then
    Agg1LB = InputBox("Enter Batch Weight of Aggregate 1 (in pounds):","Agg1LB",1500,XBox,YBox)
    Agg1SG = InputBox("Enter Specific Gravity Value for Aggregate 1:","Agg1SG",2.70,XBox,YBox)
    Agg1V = Agg1LB/(Agg1SG*62.4)
    Agg2LB = InputBox("Enter Batch Weight of Aggregate 2 (in pounds):","Agg2LB",1000,XBox,YBox)
    Agg2SG = InputBox("Enter Specific Gravity Value for Aggregate 2:","Agg2SG",2.70,XBox,YBox)
    Agg2V = Agg2LB/(Agg2SG*62.4)
    Agg3LB = InputBox("Enter Batch Weight of Aggregate 3 (in pounds):","Agg3LB",500,XBox,YBox)
    Agg3SG = InputBox("Enter Specific Gravity Value for Aggregate 3:","Agg3SG",2.70,XBox,YBox)
    Agg3V = Agg3LB/(Agg3SG*62.4)
    TotAggV = Agg1V + Agg2V + Agg3V
   ElseIf NumAggs = 4 Then
    Agg1LB = InputBox("Enter Batch Weight of Aggregate 1 (in pounds):","Agg1LB",1000,XBox,YBox)
    Agg1SG = InputBox("Enter Specific Gravity Value for Aggregate 1:","Agg1SG",2.70,XBox,YBox)
    Agg1V = Agg1LB/(Agg1SG*62.4)
    Agg2LB = InputBox("Enter Batch Weight of Aggregate 2 (in pounds):","Agg2LB",1000,XBox,YBox)
    Agg2SG = InputBox("Enter Specific Gravity Value for Aggregate 2:","Agg2SG",2.70,XBox,YBox)
    Agg2V = Agg2LB/(Agg2SG*62.4)
    Agg3LB = InputBox("Enter Batch Weight of Aggregate 3 (in pounds):","Agg3LB",500,XBox)
    Agg3SG = InputBox("Enter Specific Gravity Value for Aggregate 3:","Agg3SG",2.70,YBox)
    Agg3V = Agg3LB/(Agg3SG*62.4)
    Agg4LB = InputBox("Enter Batch Weight of Aggregate 4 (in pounds):","Agg4LB",500,XBox,YBox)
    Agg4SG = InputBox("Enter Specific Gravity Value for Aggregate 4:","Agg4SG",2.70,XBox,YBox)
    Agg4V = Agg4LB/(Agg4SG*62.4)
    TotAggV = Agg1V + Agg2V + Agg3V + Agg4V
   Else
   End If
  NumCems = InputBox("Enter Total Number of Cementitious Materials used in mix: (ex: portland cement + fly ash + GGBS + etc.)","Number Cementitious Materials Used Input",2,XBox,YBox)
   If NumCems = 1 Then
    Cem1LB = InputBox("Enter Batch Weight of Cementitious Material 1 (in pounds):","Cem1LB",565,XBox,YBox)
    Cem1SG = InputBox("Enter Specific Gravity Value for Cementitious Material 1:","Cem1SG",3.15,XBox,YBox)
    Cem1V = Cem1LB/(Cem1SG*62.4)
    TotCemV = Cem1V
    Water = InputBox("Enter Total Water Weight in Mix (in pounds):","Water Input",260,XBox,YBox)
    WaterV = Water/62.4
    TotVolX = TotAggV + TotCemV + WaterV
    TotVol = Round(TotVolX,2)
    CYVolX = TotVolX/27
    CYVol = Round(CYVolX,2)
PasteAgg1 = (TotVolX-TotAggV)/TotAggV
PasteAggRatio = Round(PasteAgg1,3)
Msgbox "The Paste/Aggregate volume ratio for this mix design is: " & PasteAggRatio & " "
   ElseIf NumCems = 2 Then
    Cem1LB = InputBox("Enter Batch Weight of Cementitious Material 1 (in pounds):","Cem1LB",452,XBox,YBox)
    Cem1SG = InputBox("Enter Specific Gravity Value for Cementitious Material 1:","Cem1SG",3.15,XBox,YBox)
    Cem1V = Cem1LB/(Cem1SG*62.4)
    Cem2LB = InputBox("Enter Batch Weight of Cementitious Material 2 (in pounds):","Cem2LB",113,XBox,YBox)
    Cem2SG = InputBox("Enter Specific Gravity Value for Cementitious Material 2:","Cem2SG",2.60,XBox,YBox)
    Cem2V = Cem2LB/(Cem2SG*62.4)
    TotCemV = Cem1V + Cem2V
    Water = InputBox("Enter Total Water Weight in Mix (in pounds):","Water Input",260,XBox,YBox)
    WaterV = Water/62.4
    TotVolX = TotAggV + TotCemV + WaterV
    TotVol = Round(TotVolX,2)
    CYVolX = TotVolX/27
    CYVol = Round(CYVolX,2)
PasteAgg1 = (TotVolX-TotAggV)/TotAggV
PasteAggRatio = Round(PasteAgg1,3)
Msgbox "The Paste/Aggregate volume ratio for this mix design is: " & PasteAggRatio & " "
   ElseIf NumCems = 3 Then
    Cem1LB = InputBox("Enter Batch Weight of Cementitious Material 1 (in pounds):","Cem1LB",452,XBox,YBox)
    Cem1SG = InputBox("Enter Specific Gravity Value for Cementitious Material 1:","Cem1SG",3.15,XBox,YBox)
    Cem1V = Cem1LB/(Cem1SG*62.4)
    Cem2LB = InputBox("Enter Batch Weight of Cementitious Material 2 (in pounds):","Cem2LB",60,XBox,YBox)
    Cem2SG = InputBox("Enter Specific Gravity Value for Cementitious Material 2:","Cem2SG",2.60,XBox,YBox)
    Cem2V = Cem2LB/(Cem2SG*62.4)
    Cem3LB = InputBox("Enter Batch Weight of Cementitious Material 3 (in pounds):","Cem3LB",53,XBox,YBox)
    Cem3SG = InputBox("Enter Specific Gravity Value for Cementitious Material 3:","Cem3SG",2.60,XBox,YBox)
    Cem3V = Cem3LB/(Cem3SG*62.4)
    TotCemV = Cem1V + Cem2V + Cem3V
    Water = InputBox("Enter Total Water Weight in Mix (in pounds):","Water Input",260,XBox,YBox)
    WaterV = Water/62.4
    TotVolX = TotAggV + TotCemV + WaterV
    TotVol = Round(TotVolX,2)
    CYVolX = TotVolX/27
    CYVol = Round(CYVolX,2)
PasteAgg1 = (TotVolX-TotAggV)/TotAggV
PasteAggRatio = Round(PasteAgg1,3)
Msgbox "The Paste/Aggregate volume ratio for this mix design is: " & PasteAggRatio & " "
   ElseIf NumCems = 4 Then
    Cem1LB = InputBox("Enter Batch Weight of Cementitious Material 1 (in pounds):","Cem1LB",452,XBox,YBox)
    Cem1SG = InputBox("Enter Specific Gravity Value for Cementitious Material 1:","Cem1SG",3.15,XBox,YBox)
    Cem1V = Cem1LB/(Cem1SG*62.4)
    Cem2LB = InputBox("Enter Batch Weight of Cementitious Material 2 (in pounds):","Cem2LB",60,XBox,YBox)
    Cem2SG = InputBox("Enter Specific Gravity Value for Cementitious Material 2:","Cem2SG",2.60,XBox,YBox)
    Cem2V = Cem2LB/(Cem2SG*62.4)
    Cem3LB = InputBox("Enter Batch Weight of Cementitious Material 3 (in pounds):","Cem3LB",28,XBox,YBox)
    Cem3SG = InputBox("Enter Specific Gravity Value for Cementitious Material 3:","Cem3SG",2.60,XBox,YBox) 
    Cem3V = Cem3LB/(Cem3SG*62.4)
    Cem4LB = InputBox("Enter Batch Weight of Cementitious Material 4 (in pounds):","Cem4LB",53,XBox,YBox)
    Cem4SG = InputBox("Enter Specific Gravity Value for Cementitious Material 4:","Cem4SG",2.60,XBox,YBox)
    Cem4V = Cem4LB/(Cem4SG*62.4)
    TotCemV = Cem1V + Cem2V + Cem3V + Cem4V
    Water = InputBox("Enter Total Water Weight in Mix (in pounds):","Water Input",260,XBox,YBox)
    WaterV = Water/62.4
    TotVolX = TotAggV + TotCemV + WaterV
    TotVol = Round(TotVolX,2)
    CYVolX = TotVolX/27
    CYVol = Round(CYVolX,2)
PasteAgg1 = (TotVolX-TotAggV)/TotAggV
PasteAggRatio = Round(PasteAgg1,3)
Msgbox "The Paste/Aggregate volume ratio for this mix design is: " & PasteAggRatio & " "
   Else
   End If
End If
 Else
If Data = "pp" Then
Datachunk="pp"
  Paste = InputBox("Enter Known Percent Paste Volume in Mixture:","Paste Volume % Input",30.0,XBox,YBox)
Else
Datachunk="ap"
AggPercent = InputBox("Enter Known Percent Aggregate Volume in Mixture:","Aggregate Volume % Input",65.0,XBox,YBox)
NotAggPct = 100-AggPercent
End If
 End If
End If

'*******************************************************************************************
' Define ASTM C457 Specifications
'  minArea1 is in sq.cm, minArea2 is in sq.in.
'  minTrav1 is in mm, minTrav2 is in inches.

If AggTop >= 6 Then
 minArea1 = 1613
 minArea2 = 250
 minTrav1 = 4064
 minTrav2 = 160
 minPoint = 2400

ElseIf AggTop >= 3 Then
 minArea1 = 419
 minArea2 = 65
 minTrav1 = 3048
 minTrav2 = 120
 minPoint = 1800

ElseIf AggTop >= 1.5 Then
 minArea1 = 241
 minArea2 = 37
 minTrav1 = 2540
 minTrav2 = 100
 minPoint = 1500

ElseIf AggTop >= 1 Then
 minArea1 = 77
 minArea2 = 12
 minTrav1 = 2413
 minTrav2 = 95
 minPoint = 1425

ElseIf AggTop >= .75 Then
 minArea1 = 71
 minArea2 = 11
 minTrav1 = 2286
 minTrav2 = 90
 minPoint = 1350

ElseIf AggTop >= .5 Then
 minArea1 = 65
 minArea2 = 10
 minTrav1 = 2032
 minTrav2 = 80
 minPoint = 1200

ElseIf AggTop >= .375 Then
 minArea1 = 58
 minArea2 = 9
 minTrav1 = 1905
 minTrav2 = 75
 minPoint = 1125

ElseIf AggTop < .375 Then
 minArea1 = 45
 minArea2 = 7
 minTrav1 = 1397
 minTrav2 = 55
 minPoint = 1000

Else
End If

If PastePointCount = 23 Then
 '*******************************************************************************************
 ' 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
 '*******************************************************************************************
 ' Determines if desired file is open in Photoshop, prompts user to close any other files.
 If appRef1.Documents.Count > 0 Then
  OpenFile = Msgbox("Is RGB file to be point counted already open in Photoshop?",36,"Determine if RGB File is Already Open")
  file = DefaultfileRGB 
  fileName = Path1 & file & ".tif"
  If OpenFile = 6 Then
   If appRef1.Documents.Count > 1 Then  
    Msgbox "Please ensure RGB image to be point counted is the only file open in Photoshop and click the 'OK' button" 
     For h = 0 to 3
      If appRef1.Documents.Count > 1 Then
       Msgbox "There are currently " & appRef1.Documents.Count & " documents open in Photoshop, please ensure RGB image to be point counted is the only file open in Photoshop and click the 'OK' button."
       h = 0
      Else
       Set ScanDoc = appRef1.ActiveDocument
       h = 3
      End If
     Next
   Else
    Set ScanDoc = appRef1.ActiveDocument
   End If
  Else
   ' Open Scanned Image
   Set ScanDoc = appRef1.Open(fileName)
   If appRef1.Documents.Count > 1 Then  
    Msgbox "Please ensure RGB image to be point counted is the only file open in Photoshop and click the 'OK' button" 
     For h = 0 to 3
      If appRef1.Documents.Count > 1 Then
       Msgbox "There are currently " & appRef1.Documents.Count & " documents open in Photoshop, please ensure RGB image to be point counted is the only file open in Photoshop and click the 'OK' button."
       h = 0
      Else
       Set ScanDoc = appRef1.ActiveDocument
       h = 3
      End If
     Next
   Else
    Set ScanDoc = appRef1.ActiveDocument
   End If
  End If
 Else
  file = DefaultfileRGB
  fileName = Path1 & file & ".tif"
  Set ScanDoc = appRef1.Open(fileName)
 End If
ScanDoc.Selection.Deselect
msgbox"At this time, use the Photoshop Rectangular Marquee Tool to select the region to be analyzed.",0
msgbox"",0,"Confirm that an area has been selected"
  appRef1.DoAction "Crop", "C457"
 '*******************************************************************************************
 ' Collects the image's size in pixels
 Xrgb = ScanDoc.Width
 Yrgb = ScanDoc.Height
 '*******************************************************************************************
 ' Set 200 pixel by 200 pixel sections of sample for point count 
 NumPtsX = (Round(Xrgb/200,0) - 1)
 NumPtsY = (Round(Yrgb/200,0) - 1)
 MaxPts = NumPtsX * NumPtsY
 NumPts1 = "Enter number of points to count (Maximum for this image = " & MaxPts & "): "   
 NumPts2 = "Enter number of points"
 NumPts3 = 15
 NumPts = InputBox(NumPts1,NumPts2,NumPts3,XBox,YBox)
 If (NumPts - 0) > (MaxPts - 0) Then
  ss = 2
 Else
  ss = 1
 End If

 For uu = 0 to 3
 If ss = 2 Then
  NumPts1 = "This image is not large enough for " & NumPts & " points.  Please re-enter number of points to count (Maximum for this image = " & MaxPts & "): "   
  NumPts2 = "Re-enter number of points"
  NumPts3 = NumPts
  NumPts = InputBox(NumPts1,NumPts2,NumPts3,XBox,YBox)
  If (NumPts - 0) > (MaxPts - 0) Then
   uu = 0
  Else
   uu = 3
  End If
 Else
 End If
 Next

 Air = 0
 Paste2 = 0
 Agg = 0
 Tot = 0

 For countY = 0 to NumPtsY
  For countX = 0 to NumPtsX
   X1 = 200*countX
   X2 = (200*countX) + 200
   Y1 = 200*countY
   Y2 = (200*countY) + 200
   ScanDoc.Selection.Select Array(Array(X1, Y1), Array(X2, Y1), Array(X2, Y2), Array(X1, Y2))
   ScanDoc.Selection.Copy
   Set Pointy = appRef1.Documents.Add(200,200) 
   Pointy.Paste
   XHairs = Path1 & "XHair.psd"
   Set CrossHairs = appRef1.Open(XHairs)
   CrossHairs.Selection.SelectAll
   CrossHairs.Selection.Copy
   CrossHairs.Close
   Pointy.Paste
   fileAA = "Junkme.psd"   
   fileBB = Path1 & fileAA
   ScanDoc.SaveAs fileBB
   CountemText1 = "Choose (a) for Aggregate, (n) for Not Aggregate.  The statistics of the " & Tot & " points counted are: " & AggPct & "% Aggregate, " & NotAggPct & "% Not Aggregate."
   CountemText2 = "Enter point"
   CountemText3 = "R"
   Countem = InputBox(CountemText1,CountemText2,CountemText3,XBox2,YBox2)

   For countP = 0 to 4
    If Countem = "a" Then
     Agg = Agg + 1
     Tot = Tot + 1
     countP = 4
    ElseIf Countem = "n" Then
     NotAgg = NotAgg + 1
     Tot = Tot + 1
     countP = 4
    Else
     CountemText1 = "Your previous entry was an invalid choice, Choose (a) for Aggregate, (n) for Not Aggregate.  The statistics of the " & Tot & " points counted are: " & AggPct & "% Aggregate, " & NotAggPct & "% Not Aggregate."
     CountemText2 = "Re-enter point"
     CountemText3 = "R"
     Countem = InputBox(CountemText1,CountemText2,CountemText3,XBox2,YBox2)
     count = 1
    End If 
   Next
   Pointy.Close 

   If (Tot - 0) = (NumPts - 0) Then
    countY = NumPtsY
    countX = NumPtsX
   Else
   End If  

 AggPct = Round(100*Agg/Tot,2)
 NotAggPct = Round(100*NotAgg/Tot,2)

  Next
 Next

 Msgbox "The statistics of the " & Tot & " points counted are: " & AggPct & "% Aggregate, " & NotAggPct & "% Not Aggregate."
Datachunk="manualcount"
 ScanDoc.Close ( 2)
Else
End If
'*******************************************************************************************
' 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
'*******************************************************************************************
' Determines if desired file is open in Photoshop, prompts user to close any other files.
If appRef1.Documents.Count > 0 Then
 OpenFile = Msgbox("Is B/W file to be analyzed already open in Photoshop?",36,"Determine if File is Already Open")
 file = Defaultfile 
 fileName = Path1 & file & ".tif"
 If OpenFile = 6 Then
  If appRef1.Documents.Count > 1 Then  
   Msgbox "Please ensure B/W image to be analyzed is the only file open in Photoshop and click the 'OK' button" 
    For h = 0 to 3
     If appRef1.Documents.Count > 1 Then
      Msgbox "There are currently " & appRef1.Documents.Count & " documents open in Photoshop, please ensure B/W image to be analyzed is the only file open in Photoshop and click the 'OK' button."
      h = 0
     Else
      Set ScanDoc = appRef1.ActiveDocument
      h = 3
     End If
    Next
  Else
   Set ScanDoc = appRef1.ActiveDocument
  End If
 Else
  ' Open Scanned Image
  Set ScanDoc = appRef1.Open(fileName)
  If appRef1.Documents.Count > 1 Then  
   Msgbox "Please ensure B/W image to be analyzed is the only file open in Photoshop and click the 'OK' button" 
    For h = 0 to 3
     If appRef1.Documents.Count > 1 Then
      Msgbox "There are currently " & appRef1.Documents.Count & " documents open in Photoshop, please ensure B/W image to be analyzed is the only file open in Photoshop and click the 'OK' button."
      h = 0
     Else
      Set ScanDoc = appRef1.ActiveDocument
      h = 3
     End If
    Next
  Else
   Set ScanDoc = appRef1.ActiveDocument
  End If
 End If
Else
 file = Defaultfile
 fileName = Path1 & file & ".tif"
 Set ScanDoc = appRef1.Open(fileName)
End If
'*******************************************************************************************
' Collects the SCANNED image's size in pixels
Xw = ScanDoc.Width
Yw = ScanDoc.Height
'*******************************************************************************************
' Defines the resolution (fixed as constant in this version)
' Calculates the scale bars (pixels/inch) (pixels/mm)
' Calculates the size of the SCANNED image
Resolution = 8
inchX = (2.54*(10^6))/(100*Resolution)
cmX = (1*(10^6))/(100*Resolution)
XwmmX = 10*Xw/cmX
YwmmX = 10*Yw/cmX
Xwmm = Round(XwmmX,2)
Ywmm = Round(YwmmX,2)
Xwmmm = Round(XwmmX,0)
YWmmm = Round(YwmmX,0)
'*******************************************************************************************
' Prompts the user for area to be analyzed, Calculates area to be analyzed, loops until user is satisfied
'*******************************************************************************************
ScanDoc.Selection.Deselect
msgbox"At this time, use the Photoshop Rectangular Marquee Tool to select a region to be analyzed.",0
msgbox"",0,"Confirm that an area has been selected"
Do Until u = 1
Set currentHistory = ScanDoc.HistoryStates( 1 )
  appRef1.DoAction "Crop", "C457"
  Xsel = ScanDoc.Width
  Ysel = ScanDoc.Height
    AreasqcmX = (Xsel*Ysel*(Resolution^2)*100*100)/(10^12)
    Areasqcm = Round(AreasqcmX,2)
    AreasqinX = Areasqcm/6.4516
    Areasqin = Round(Areasqin,2)
      If Areasqcm < minArea1 Then
      ContinueQ2 = MsgBox("Area to be analyzed (" & Areasqcm & " sq.cm) is less than ASTM C457 requirement (" & minArea1 & " sq.cm).  Click Yes to ignore and continue, or No to select a new area:",4,"Prompt if Area is Less than ASTM Requirement")
        If ContinueQ2 = 6 Then
        u = 1
        Else
ScanDoc.ActiveHistoryState = currentHistory
ScanDoc.Selection.Deselect
        msgbox"Use the Photoshop Rectangular Marquee Tool to select a larger region to be analyzed.",0
msgbox"",0,"Confirm that an area has been selected"
        u = 0
        End If
      Else
      areamessage = "Area to be analyzed = " & Areasqcm & " square centimeters meets or exceeds ASTM C457 requirement (" & minArea1 & " mm).  This area is outlined on the Photoshop image.  If this area is sufficient, click Yes, or to select a different area, click No"
      ContinueQ3 = Msgbox(areamessage,4,"Prompt for Confirmation of Selected Area")
         If ContinueQ3 = 6 Then         
u = 1
         Else
ScanDoc.ActiveHistoryState = currentHistory
ScanDoc.Selection.Deselect
        msgbox"Use the Photoshop Rectangular Marquee Tool to select a region to be analyzed.",0
msgbox"",0,"Confirm that an area has been selected"
        u = 0
        End If
      End If
Loop

  appRef1.DoAction "Crop", "C457"


' 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
'*******************************************************************************************
'Determine total traverse length - script runs "iterations" - it extracts a
'set of 19 parallel lines (this set of lines = 1 iteration).

Do Until uu = 1

NumIts1 = InputBox("Enter a Number of Iterations to Run (this value determines the total traverse length): ","Number of Iterations Entry",2,XBox,YBox)
NumIts = Round(NumIts1,0)
If NumIts = 0 Then
Do Until NumIts > 0
NumIts1 = InputBox("The Number of Iterations for This Program Must be an Integer, You Have Entered either a Non-Integer of " & NumIts1 & ". Please Re-enter a Number of Iterations: ","Number of Iterations Entry",NumIts,XBox,YBox)
NumIts = Round(NumIts1,0)
Loop
End If  

Ycropped = ScanDoc.Height
TraverseCheck = Ysel*(Resolution/1000)*19*NumIts
If TraverseCheck < minTrav1 Then
      	ContinueQQ2 = MsgBox("Total traverse length (" & TraverseCheck & " mm) is less than ASTM C457 requirement (" & minTrav1 & " mm).  Click Yes to ignore and continue, or No to increase # of iterations:",4,"Total Traverse length DOES NOT meet ASTM Requirement")
        If ContinueQQ2 = 6 Then
        uu = 1
        Else
	uu = 0
	End If
End If
If TraverseCheck >= minTrav1 Then	
	ContinueQQ3 = MsgBox("Total traverse length (" & TraverseCheck & " mm) meets or exceeds ASTM C457 requirement (" & minTrav1 & " mm).  Click Yes to continue, or No to change the # of iterations:",4,"Total Traverse length meets ASTM Requirement")
        If ContinueQQ3 = 6 Then
        uu = 1
	Else
	uu = 0
	End If
End If
Loop

' Set small section of sample to be viewed and set Threshold
Set xlsApp = Createobject("Excel.Application")
  With xlsApp
   xlsApp.Visible = False
   xlsApp.Workbooks.Add
  End With

For count = 0 to 3
 xlsApp.Range("B2").Select
 xlsApp.ActiveCell.FormulaR1C1 = "=RAND()"
 xlsApp.Range("B3").Select
 RanderY = Ysel-200
 RanderX = Xsel-200
 RandoY = "=R[-1]C*" & RanderY & "+100"
 xlsApp.ActiveCell.FormulaR1C1 = RandoY
  xlsApp.Range("B3").Select
  xlsApp.Selection.Copy
  xlsApp.Selection.pastespecial 12
RandoY = Round(xlsApp.Range("B3"),0)

 xlsApp.Range("B4").Select
 RandoX = "=R[-2]C*" & RanderX & "+100"
 xlsApp.ActiveCell.FormulaR1C1 = RandoX
  xlsApp.Selection.Copy
  xlsApp.Selection.pastespecial 12
RandoX = Round(xlsApp.Range("B4"),0)

 If count = 0 Then
  THolda = InputBox("Enter Desired Threshold Value (0-255): ","Threshold Value Input","91",XBox,YBox)
  THoldStep = 10
 Else
  THoldQ = MsgBox("Is the sample image location sufficient to judge thresholding?",4,"Image Location Adjustment")
  THoldText = "Enter New Threshold Value (Previous Value = " & THolda & ".  Note that selecting a value near 0 will result in an image with more white pixels while a value near 255 will result in an image with more black pixels): "
  THolda = InputBox(THoldText,"Threshold Value Adjustment",THolda,XBox,YBox)
  THoldStep = 10
  THoldTest.Close 2
    End If


 Size = 200
 ScanDoc.Selection.Select Array(Array(RandoX, RandoY), Array(RandoX + Size, RandoY), Array(RandoX + Size, RandoY + Size), Array(RandoX, RandoY + Size))
 ScanDoc.Selection.Copy
 xlsApp.Range("A1").Select
 xlsApp.ActiveCell.FormulaR1C1 = THolda
 THold = xlsApp.Range("A1")
 FormatNumber THold,0
 Set THoldTest = appRef1.Documents.Add(3*Size,2*Size)
 THoldTest.Paste
 THoldTest.ActiveLayer.Translate 0,Size/2
 THoldTest.Paste
 Tholdm1 = Thold - 2*THoldStep
 If Tholdm1 < 0 Then
  Tholdm1 = 0
  Else
 End If
 THoldTest.ActiveLayer.Translate -Size,Size/2
 THoldTest.ActiveLayer.Threshold THoldm1
 THoldTest.Paste
 Tholdm2 = Thold - THoldStep
 If Tholdm2 < 0 Then
  Tholdm2 = 0
  Else
 End If
 THoldTest.ActiveLayer.Translate -Size,-Size/2
 THoldTest.ActiveLayer.Threshold THoldm2
 THoldTest.Paste
 Thold1 = Thold + 2*THoldStep
  If Thold1 > 255 Then
  Thold1 = 255
  Else
 End If
 THoldTest.ActiveLayer.Translate Size,Size/2
 THoldTest.ActiveLayer.Threshold THold1
 THoldTest.Paste
 Thold2 = Thold + THoldStep
 If Thold2 > 255 Then
  Thold2 = 255
  Else
 End If
 THoldTest.ActiveLayer.Translate Size,-Size/2
 THoldTest.ActiveLayer.Threshold THold2
 THoldTest.Paste
 THoldTest.ActiveLayer.Translate 0,-Size/2
 THoldTest.ActiveLayer.Threshold THold
 THoldTest.Paste
 THoldTest.ActiveLayer.Translate -Size,Size/2
 THoldTest.ActiveLayer.Opacity = 75
 THoldTest.Paste
 THoldTest.ActiveLayer.Translate -Size,-Size/2
 THoldTest.ActiveLayer.Opacity = 75
 THoldTest.Paste
 THoldTest.ActiveLayer.Translate Size,Size/2
 THoldTest.ActiveLayer.Opacity = 75
 THoldTest.Paste
 THoldTest.ActiveLayer.Translate Size,-Size/2
 THoldTest.ActiveLayer.Opacity = 75
 THoldTest.Paste
 THoldTest.ActiveLayer.Translate 0,-Size/2
 THoldTest.ActiveLayer.Opacity = 75
 TVal = PathA & THoldm1 & ".tif"
 Set TVal1 = appRef1.Open(TVal)
 TVal1.Selection.SelectAll
 TVal1.Selection.Copy
 TVal1.Close
 THoldTest.Paste
 THoldTest.ActiveLayer.Translate -Size,Size/2
 TVal = PathA & THoldm2 & ".tif"
 Set TVal1 = appRef1.Open(TVal)
 TVal1.Selection.SelectAll
 TVal1.Selection.Copy
 TVal1.Close
 THoldTest.Paste
 THoldTest.ActiveLayer.Translate -Size,-Size/2
 TVal = PathA & THold1 & ".tif"
 Set TVal1 = appRef1.Open(TVal)
 TVal1.Selection.SelectAll
 TVal1.Selection.Copy
 TVal1.Close
 THoldTest.Paste
 THoldTest.ActiveLayer.Translate Size,Size/2
 TVal = PathA & THold2 & ".tif"
 Set TVal1 = appRef1.Open(TVal)
 TVal1.Selection.SelectAll
 TVal1.Selection.Copy
 TVal1.Close
 THoldTest.Paste
 THoldTest.ActiveLayer.Translate Size,-Size/2
 TVal = PathA & THold & ".tif"
 Set TVal1 = appRef1.Open(TVal)
 TVal1.ActiveLayer.Invert ()
 TVal1.Selection.SelectAll ()
 TVal1.Selection.Copy ()
 TVal1.Close (2)
 THoldTest.Paste
 THoldTest.ActiveLayer.Translate 0,-Size/2
 message = "Is Selected Image Display and Threshold (" & THold & ") Adjustment Sufficient?"
 TTest = MsgBox(message,4,"Threshold Test")
  If TTest = 6 Then
   count = 3
   THoldTest.Close 2
  Else
   count = 1
 End If
Next

xlsApp.ActiveWorkBook.Close False
xlsApp.Quit
'*******************************************************************************************
' Allow User Opportunity to "Erase" Air Voids found within Aggregate Particles or Cracks
ScanDoc.Selection.Deselect
msgbox "At this time, use Photoshop tools to remove air voids found within aggregate particles and cracks that are not desired in the analysis.  When the voids and cracks are sufficiently masked, or if no adjustments are necessary, click the OK button below and the analysis will continue."
msgbox "Once you are satisfied with the image, it is suggested that the edited image be resaved with a new filename and then click OK to analyze per ASTM C457."

Set Bcolor = appRef1.BackgroundColor

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

Set Fcolor = appRef1.ForegroundColor

    With Fcolor
        .RGB.Red = 0
        .RGB.Green = 0
        .RGB.Blue = 0
    End With

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

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)
 IThold = 255-THold
  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 a "scan rotate" if NumberRotations >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.ResizeCanvas ThumbNailx,ThumbNaily

ScanDoc.ActiveLayer.Threshold THold
ScanDoc.ActiveLayer.Invert
ScanDoc.ResizeCanvas 300,586
fileNameRb = "Thresh_Report.jpg"
fileNameRR = Path1 & fileNameRb
ScanDoc.SaveAs fileNameRR, 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
'*******************************************************************************************
' 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 & ".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"

 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 & ".doc"
 wordsum.SaveAs fileName9

 xlsApp.ActiveWorkBook.Close True
 xlsApp.Quit


 'Open Workbook to view data from analyses
   Set xlsApp = Createobject("Excel.Application")
    With xlsApp
     xlsApp.Visible = True
     xlsApp.DisplayAlerts = False
     xlsApp.Workbooks.Open filenameJC
    End With

 xlsApp.Sheets("Pg1").Select