'########################################################################
'Code: MultiHistogram
'Application: Grapher Scripter

'Purpose: To plot separate histogram for a range of columns

'Final Graph is automatically saved in and with the name of the directory
'that contains the datafiles

'Users:	 Grapher (Golden Software)
'Original Author: Niels Hartog
'Date:	 Sep 2005 by Niels Hartog (niels.hartog+troep@gmail.com)
'Remove "+troep" when sending email

'Feel free to tune the source code to your needs
'But please leave these header lines in tact.
'Date modified:
'Modified by:
'#########################################################################

Sub Main
	Dim Grapher, Docs, Plot, WksRangeXCol, WksRangeYCol, WksRange4, wks, Graph, PageSetup As Object
	Dim r, colstart, colend, LastCol, X, SquareSide As Integer
	Dim cols, FileExt, inPath As String
	Dim xCol, yCol, zCol As Long
	Dim StartTime, GraphWidth, GraphHeight As Double

	Set Grapher = CreateObject("Grapher.Application")
	Grapher.Visible = False
	Set Docs = Grapher.Documents
	Set Plot = Docs.Add(grfPlotDoc)

'Assigns the AutoShapes collection to
'the variable named Shapes
 Dim Shapes As Object
 Set Shapes = Plot.Shapes


	inPath=GetFilePath("","dat;xls;txt;csv","","Select Data File In Target Folder") 'get full file path
	If inPath ="" Then End
	FileExt=Right(inPath,4)
	Set wks = Grapher.Documents.Open(inPath)
	LastCol = wks.UsedRange.LastColumn

Dim lists() As String
ReDim lists(r To LastCol)
	For r=1 To LastCol
    	lists$(r) = Str(r) & ": " & Str(wks.Cells(1,r))
    Next
	Begin Dialog UserDialog 200,308 ' %GRID:10,7,1,1
		Text 10,10,180,15,"Select First Data Column"
		ListBox 10,28,180,238,lists(),.list
		OKButton 80,273,40,21
	    End Dialog
	    Dim Colz1 As UserDialog
	    Colz1.list = -1
	    Dialog Colz1 ' show dialog (wait for ok)
	    colstart=Colz1.list+1
		If Str(colstart)= 0 Then
		Exit All
		End If

	Begin Dialog UserDialog 200,308 ' %GRID:10,7,1,1
		Text 10,10,180,15,"Select Last Data Column"
		ListBox 10,28,180,238,lists(),.list
		OKButton 80,273,40,21
	    End Dialog
	    Dim Colz2 As UserDialog
	    Colz2.list = -1
	    Dialog Colz2 ' show dialog (wait for ok)
	    colend=Colz2.list+1
		If Str(colend)= 0 Then
		Exit All
		End If

Debug.Print "************************************" + Str(Time) + "************************************"
StartTime=Timer

Set PageSetup = Plot.PageSetup
Debug.Print PageSetup.LeftMargin
Debug.Print PageSetup.RightMargin
Debug.Print PageSetup.width
Debug.Print Plot.PageSetup.pageSize

SquareSide = Round(IIf(Sqr(1+colend-colstart)=0,Fix(Sqr(1+colend-colstart)),1+Fix(Sqr(1+colend-colstart))))
r=colstart



		Set Graph = Shapes.AddHistogramGraph(inPath,r,Str(wks.Cells(1,r)))
		Graph.Plots(1).DisplayRelFreq = False
		'Graph.Axes(grfYAxis).AutoMax = False
		'Graph.Axes(grfYAxis).Max = 0
		'Graph.Axes(grfYAxis).Max = 1
		Graph.Axes(grfXAxis).title.text=Str(wks.Cells(1,r))
		GraphWidth=Graph.width
		GraphHeight=Graph.height
		Debug.Print "Done :" & Str(wks.Cells(1,r))
		Graph.left = PageSetup.LeftMargin+(((r-colstart)Mod SquareSide)*(GraphWidth))
		Graph.top = (PageSetup.height-PageSetup.TopMargin)-(Fix((r-colstart)/SquareSide)*(GraphHeight))
		r=r+1

While r <=colend
		Set Graph = Shapes.AddHistogramGraph(inPath,r,Str(wks.Cells(1,r)))
		Graph.Plots(1).DisplayRelFreq = False
		'Graph.Axes(grfYAxis).AutoMax = False
		'Graph.Axes(grfYAxis).Max = 0
		'Graph.Axes(grfYAxis).Max = 1
		Graph.Axes(grfXAxis).title.text=Str(wks.Cells(1,r))
		Graph.width=GraphWidth
		Graph.height=GraphHeight
		Debug.Print "Done :" & Str(wks.Cells(1,r))
		Graph.left = PageSetup.LeftMargin+(((r-colstart)Mod SquareSide)*(GraphWidth))
		Graph.top = (PageSetup.height-PageSetup.TopMargin)-(Fix((r-colstart)/SquareSide)*(GraphHeight))
		r=r+1
Wend
Grapher.Visible = True

Debug.Print "Done after: " & CStr(Round((Timer-StartTime),0)) & " seconds"

Debug.Print "Saved: " & Replace(inPath,FileExt,"_histogram.grf")

Plot.SaveAs(Replace(inPath,FileExt,"_histogram.grf"))


End Sub