Mam za to, ze se tady nedavno resilo, ze chtel nekdo tisknout soucty
za jednotlive stranky. Protoze to ted po me nekdo chcel, tak jsem
hledal jestli se to povedlo nejak vyresit a nejak jsem neuspel ..
(nenasel jsem ani zadani, ale predpokladam ze slo o tuto
konferenci..). Tak, kdyz by to jeste nekno potreboval, tak jsem napsal
makro, co by to mohlo resit ..
Kamil
----------------------------------------------------------------------
Option Explicit
Sub tisk_stran()
Dim poc_rad As Integer
Dim fp_rad As Integer
Dim k_rad As Integer, fk_rad As Integer
poc_rad = 57
Cells(1, 1).Select
Selection.End(xlDown).Select
k_rad = Mid(ActiveCell.Address(), 4) 'format adresy $A$radek
If Cells(k_rad, 1) = "Celkem:" Then
k_rad = k_rad - 2 'když jsou na poslednich dvou radcich součty
End If
'Na posledni dva radky dopln soucty
Cells(k_rad + 1, 1) = "Celkem za stránku:"
Cells(k_rad + 2, 1) = "Celkem:"
Cells(k_rad + 2, 2) = "=SUM(B2:B" & k_rad & ")"
fk_rad = 1
Do
Rows("1:" & k_rad).Hidden = False 'zobraz vše
fp_rad = fk_rad + 1
fk_rad = fk_rad + poc_rad
' Když nezačíname schovat začátek
If fp_rad > 2 Then
Rows("2:" & fp_rad - 1).Hidden = True
End If
' Když nekončíme schovat konec
If fk_rad < k_rad Then
Rows(fk_rad + 1 & ":" & k_rad).Hidden = True
' Vložit mezisoučet
Cells(k_rad + 1, 2) = "=SUM(B" & fp_rad & ":B" & fk_rad & ")"
Else
' Upravený mezisoučet na kratší konec
Cells(k_rad + 1, 2) = "=SUM(B" & fp_rad & ":B" & k_rad & ")"
End If
ActiveWindow.SelectedSheets.PrintPreview ' potom se da zadat print
Loop While fk_rad < k_rad
Rows("1:" & k_rad).Hidden = False 'zobraz vše
End Sub
This archive was generated by hypermail 2.1.2 : 11. 03. 2002, 15:17 CET