'########################################################################
'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:
'#########################################################################



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

Dim Grapher As Object
	Set Grapher = CreateObject("Grapher.Application")
	Grapher.Visible = False
Dim Docs As Object
	Set Docs = Grapher.Documents
Dim Plot As Object
	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