'Begin Description
'Okopíruje vybranou tabulku, která je výstupem
'procedury Frequecies a doplní do ní 95%
'intervaly spolehlivosti pro procentuální
'četnosti.
'V dialogovém okně musí být zaškrtnuto pole
'Display frequency tables. Ostatní nastavení neměňte.
'Tato asymptotická metoda předpokládá,
'že počet pozorování je větší než 30
'a v každé kategorii se vyskytuje alespoň
'5 případů.
'End Description


    Dim objOutputDoc As ISpssOutputDoc
    Dim objItem As ISpssItem
    Dim objPivotTableOld As PivotTable
    Dim objPivotTableNew As PivotTable
    Dim objRowLabelsOld As ISpssLabels
    Dim objColLabelsOld As ISpssLabels
    Dim objColLabelsNew As ISpssLabels 
    Dim objRowLabelsNew As ISpssLabels      
    Dim objDataCellsOld As ISpssDataCells
    Dim objDataCellsNew As ISpssDataCells

Sub Main
	Const cNEWTABLE As String = "Intervaly spolehlivosti"
	Const cNewColumnName As String = "Nový sloupec"
	Const cNewColumnValue As String = "x"
	Const intCol As Integer = 10			'Počet sloupců
	Const  intFixCol= Array(0,1,4,7)
    Dim index As Long                   
    Dim intRow As Integer                                     
    Dim intR As Integer                     ' Loop Counter
    Dim intC As Integer                     ' Loop Counter
    Dim bolFoundOutputDoc As Boolean
	Dim bolPivotSelected As Boolean
	Dim bolFound As Boolean	
	    		
	'Vyhledání vybrané tabulky
    Call GetFirstSelectedPivot(objPivotTableOld, objItem, bolFoundOutputDoc, bolPivotSelected) 
	If (bolFoundOutputDoc = False) Or (bolPivotSelected = False) Then Exit Sub 'Tabulka nenalezena

	Set objDataCellsOld = objPivotTableOld.DataCellArray
    intRow = objDataCellsOld.NumRows
    Set objColLabelsOld = objPivotTableOld.ColumnLabelArray
    Set objRowLabelsOld = objPivotTableOld.RowLabelArray
    If intRow < 2 Or objDataCellsOld.NumColumns <> 4 Then Exit Sub

    'Vloží prázdnou tabulku
    Set objOutputDoc = objSpssApp.GetDesignatedOutputDoc
    objOutputDoc.Visible = True
	index = objOutputDoc.InsertTable( cNEWTABLE,intRow,intCol,1)
	Call GetFirstSelectedPivot(objPivotTableNew, objItem, bolFoundOutputDoc, bolPivotSelected)
	If (bolFoundOutputDoc = False) Or (bolPivotSelected = False) Then Exit Sub 'Tabulka nenalezena
    
    Set objDataCellsNew = objPivotTableNew.DataCellArray
    Set objColLabelsNew = objPivotTableNew.ColumnLabelArray
    Set objRowLabelsNew = objPivotTableNew.RowLabelArray
    objPivotTableNew.UpdateScreen = False
    
    For intR = 0 To intRow - 1
		For intC = 0 To intCol - 1
			objDataCellsNew.ValueAt(intR,intC) = cNewColumnValue
		Next intC
	Next intR
	objPivotTableNew.Autofit
	   
    'Nadpis
    If objPivotTableOld.TitleText = "" Then
		objPivotTableNew.TitleText = "Četnostní tabulka s intervaly spolehlivosti"
	Else
		objPivotTableNew.TitleText = "Četnostní tabulka s intervaly spolehlivosti proměnné " + objPivotTableOld.TitleText
	End If
	objPivotTableNew.ClearSelection
	objPivotTableNew.SelectTitle
	objPivotTableNew.HAlign = 2
	objPivotTableNew.TextFont = "Arial CE"
	objPivotTableNew.ClearSelection
			
    'Sloupcové labely
    objColLabelsNew.ValueAt(0,0) = "Statistiky"
    objColLabelsNew.TextFontAt(0,0) = "Arial CE"
    objColLabelsNew.HAlignAt(0,0) = 2
    objColLabelsNew.VAlignAt(0,0) = 1
    objColLabelsNew.ValueAt(1,0) = "Četnost"
    objColLabelsNew.ValueAt(1,1) = "Relativní četnost"
    objColLabelsNew.ValueAt(1,2) = "Dolní mez"
    objColLabelsNew.ValueAt(1,3) = "Horní mez"
    objColLabelsNew.ValueAt(1,4) = "Rel. četnost platných hodnot"
    objColLabelsNew.ValueAt(1,5) = "Dolní mez"
    objColLabelsNew.ValueAt(1,6) = "Horní mez"
    objColLabelsNew.ValueAt(1,7) = "Relativní kumulativní četnost"
    objColLabelsNew.ValueAt(1,8) = "Dolní mez"
    objColLabelsNew.ValueAt(1,9) = "Horní mez"
    For intC = 0 To intCol - 1
	    objColLabelsNew.HAlignAt(1,intC) = 2
	    objColLabelsNew.VAlignAt(1,intC) = 1
	    objColLabelsNew.TextFontAt(1,intC) = "Arial CE"
    Next intC
	objPivotTableNew.ClearSelection
    objColLabelsNew.SelectLabelAt(1,2)
	objColLabelsNew.SelectLabelAt(1,3)
	objColLabelsNew.SelectLabelAt(1,5)
	objColLabelsNew.SelectLabelAt(1,6)
	objColLabelsNew.SelectLabelAt(1,8)
	objColLabelsNew.SelectLabelAt(1,9)
	objPivotTableNew.InsertFootnote("95%ní interval spolehlivosti. K výpočtu je použita asymptotická metoda, která předpokládá, že celkový počet pozorování je větší než 30 a v každé kategorii se vyskytuje alespoň 5 případů.")
	objPivotTableNew.ClearSelection
	objPivotTableNew.SelectAllFootnotes
	objPivotTableNew.TextFont = "Arial CE"
	objPivotTableNew.ClearSelection
	objPivotTableNew.Autofit

    'Řádkové labely
    Dim strLabel As String
    objRowLabelsNew.ValueAt(0,0) = "Hodnoty"
    objRowLabelsNew.TextFontAt(0,0) = "Arial CE"
    objRowLabelsNew.HAlignAt(0,0) = 2
    objRowLabelsNew.VAlignAt(0,0) = 2
    objPivotTableNew.ClearSelection
	For intR = 0 To intRow - 1
		Select Case CStr(objRowLabelsOld.ValueAt(intR,2))
			Case "Total"
				objRowLabelsNew.ValueAt(intR,1) = "Celkem"
			Case Else
				strLabel = CVar(objRowLabelsOld.ValueAt(intR,2))
				objRowLabelsNew.ValueAt(intR,1) = Chr(255) + strLabel
		End Select
		objRowLabelsNew.HAlignAt(intR,1) = 3
	    objRowLabelsNew.VAlignAt(intR,1) = 2
		objRowLabelsNew.TextFontAt(intR,1) = "Arial CE"	    
	Next intR
	objPivotTableNew.Autofit
	 		            
    'Vytvoření skupin labelů
	Dim intGroupSize As Integer
	Dim intTotalPos As Integer
	intR = 0
	Do
		intR = intR + 1
	Loop While objRowLabelsOld.ValueAt(intR,1) = "Valid" And intR < intRow - 1
	intGroupSize = intR
	If intGroupSize < intRow - 1 Then intTotalPos = intGroupSize - 1 Else intTotalPos = intGroupSize
	objPivotTableNew.ClearSelection	
	objRowLabelsNew.SelectLabelAt(0,1)
	objPivotTableNew.Group
	objRowLabelsNew.ValueAt(0,1) = "Platné"
	objPivotTableNew.TextFont = "Arial CE"
	objPivotTableNew.HAlign = 0
	objPivotTableNew.ClearSelection
	For intR = 1 To intRow - 2
		objRowLabelsNew.SelectLabelAt(intR,2)
		objPivotTableNew.Group
		objRowLabelsNew.ValueAt(intR,1) = ""
		objPivotTableNew.ClearSelection
	Next intR
	If objRowLabelsOld.ValueAt(intGroupSize,1) = "Missing" Then
		objRowLabelsNew.ValueAt(intGroupSize,1) = "Vynechané"
		objRowLabelsNew.TextFontAt(intGroupSize,1) = "Arial CE"
		objRowLabelsNew.HAlignAt(intGroupSize,1) = 0
	End If
	objPivotTableNew.Autofit

	'Data
	ReDim strColValue(intRow) As String
	ReDim strColFormat(intRow) As String
	ReDim intColDigits(intRow) As Integer
	For intC = 0 To UBound(intFixCol)	
		For intR = 0 To intRow - 1
			 strColValue(intR) = CStr(objDataCellsOld.ValueAt(intR,intC))	
			If CStr(objDataCellsOld.ValueAt(intR,intC)) = "" Then
				strColFormat(intR) = "#.#"
				intColDigits(intR) = 0
			Else
				strColFormat(intR) = objDataCellsOld.NumericFormatAt(intR,intC)
				intColDigits(intR) = objDataCellsOld.HDecDigitsAt(intR,intC)
				If intC <>0 Then 'Nekopíruje formát, ale nutí vlastní
					strColFormat(intR) = "##.#%" 
					intColDigits(intR) = 2
				End If
			End If
		Next intR
		For intR = 0 To intRow - 1
			objDataCellsNew.ValueAt(intR,intFixCol(intC)) = strColValue(intR)	
			objDataCellsNew.NumericFormatAt(intR,intFixCol(intC)) = strColFormat(intR)
			objDataCellsNew.HDecDigitsAt(intR,intFixCol(intC)) = intColDigits(intR)
			objDataCellsNew.HAlignAt(intR,intC) = 3
		Next intR
		objPivotTableNew.Autofit	
	Next intC
  	
	'Výpočet
	Dim N As Single
	Dim F As Single

	N = objDataCellsNew.ValueAt(intRow-1,0)
	Debug.Print N
	For intR = 0 To intRow-2
		F=objDataCellsNew.ValueAt(intR,1)/100
		Lower N, F, intR, 2
		Upper N, F, intR, 3
	Next intR
		objDataCellsNew.ValueAt(intRow-1,2)=""
		objDataCellsNew.ValueAt(intRow-1,3)=""
		
	N = objDataCellsNew.ValueAt(intTotalPos,0)
	Debug.Print N
	For intR = 0 To intTotalPos - 1
		F=objDataCellsNew.ValueAt(intR,4)/100
		Lower N, F, intR, 5
		Upper N, F, intR, 6
	Next intR
	For intR = intTotalPos To IntRow - 1
		objDataCellsNew.ValueAt(intR,5)=""
		objDataCellsNew.ValueAt(intR,6)=""
	Next intR
	For intR = 0 To intTotalPos - 2
		F=objDataCellsNew.ValueAt(intR,7)/100
		Lower N, F, intR, 8
		Upper N, F, intR, 9
	Next intR
	For intR = intTotalPos - 1 To IntRow - 1
		objDataCellsNew.ValueAt(intR,8)=""
		objDataCellsNew.ValueAt(intR,9)=""
	Next intR
	
	'Formátování písma a obarvení buňek
	objPivotTableNew.ClearSelection
	For intR = 0 To intRow - 2
		If objRowLabelsNew.ValueAt(intR,2) = "Celkem" Then
			objRowLabelsNew.SelectLabelDataAt(intR,2) 
			objPivotTableNew.TextStyle = 3
			objPivotTableNew.BackgroundColor = RGB(245,245,245)
			objPivotTableNew.ClearSelection	
		End If	
	Next intR
	objPivotTableNew.ClearSelection
	objRowLabelsNew.SelectLabelDataAt(intRow-1,2) 
	objPivotTableNew.TextStyle = 2
	objPivotTableNew.BackgroundColor = RGB(235,235,235)
	objPivotTableNew.ClearSelection
	objRowLabelsNew.SelectLabelAt(0,0)
    objPivotTableNew.BackgroundColor = RGB(255,255,210)
    objPivotTableNew.ClearSelection  
	objColLabelsNew.BackgroundColorAt(0,0) = RGB(210,255,210)
	objColLabelsNew.BackgroundColorAt(1,0) = RGB(255,230,230)
	For intC = 1 To 3
		objColLabelsNew.SelectLabelAt(1,intC)
	Next intC
	objPivotTableNew.BackgroundColor = RGB(240,240,255)
	objPivotTableNew.ClearSelection
	For intC = 4 To 6
		objColLabelsNew.SelectLabelAt(1,intC)
	Next intC
	objPivotTableNew.BackgroundColor = RGB(255,250,175)
	objPivotTableNew.ClearSelection
	For intC = 7 To 9
		objColLabelsNew.SelectLabelAt(1,intC)
	Next intC
	objPivotTableNew.BackgroundColor = RGB(230,225,225)
	objPivotTableNew.ClearSelection
	
	
	
	'Úpravy před zobrazením
    objPivotTableNew.Autofit
    objPivotTableNew.ShowAll
    objPivotTableNew.UpdateScreen=True
    objItem.Deactivate
End Sub

Sub Lower (N As Single, F As Single, Row As Integer, Column As Integer)
	Const Z As Single = 1.96 
	Dim S As Single

	S=Sqr(F*(1-F)/N)
	If (F-Z*S)>0 Then
		objDataCellsNew.ValueAt(Row,Column) = CStr((F-Z*S)*100)
	Else
		objDataCellsNew.ValueAt(Row,Column) = CStr(0.00)
	End If
		objDataCellsNew.HAlignAt(Row,Column)= 3
		objDataCellsNew.NumericFormatAt(Row,Column) = "##.#%"
		objDataCellsNew.HDecDigitsAt(Row,Column) = 2
End Sub		

Sub Upper (N As Single, F As Single, Row As Integer, Column As Integer)
	Const Z As Single = 1.96 
	Dim S As Single

	S=Sqr(F*(1-F)/N)
	If (F+Z*S)<1 Then
		objDataCellsNew.ValueAt(Row,Column) = CStr((F+Z*S)*100)
	Else
		objDataCellsNew.ValueAt(Row,Column) = CStr(100.00)
	End If
		objDataCellsNew.HAlignAt(Row,Column)= 3
		objDataCellsNew.NumericFormatAt(Row,Column) = "##.#%"
		objDataCellsNew.HDecDigitsAt(Row,Column) = 2
End Sub