RE: Tabulky v Excelu

• Previous message: nefir: "Re: jak na cd s ochranou"
• Maybe in reply to: Graphics: "Tabulky v Excelu"
• Next in thread: Graphics: "Re: Tabulky v Excelu"
• Reply: Graphics: "Re: Tabulky v Excelu"
• Messages sorted by: [ date ] [ thread ] [ subject ] [ author ] [ attachment ]

Zdar a silu vsetkym, 

takze tu je to "makro":
upozornenie:
pred spustenim si treba nastavit kde sa maju vypisovat sumy
(v prislusnom oddiely zapatia treba dat napr.:
" suma stranka :sss5 EUR" 
sss -prgm vie kam ma davat sumy
5 -cislo stlpca s kt. ma sumy vyratavat

no a to makro 
---------------cut----------------------------------
Sub sums_footer()
Dim mySheet As String
Dim countPages As Long
Dim i As Long
Dim myOldRow As Long
Dim myRow As Long
Dim myEndRow As Long
Dim answer
Dim myPos As Integer
Dim sumRow As Long
Dim LFooter As String
Dim CFooter As String
Dim RFooter As String
Dim oldFooter As String
mySheet = ActiveSheet.Name
LFooter = _
Worksheets(mySheet).PageSetup.LeftFooter
CFooter = _
Worksheets(mySheet).PageSetup.CenterFooter
RFooter = _
Worksheets(mySheet).PageSetup.RightFooter

If InStr(1, LFooter, "sss") > 0 Then
myPos = InStr(1, LFooter, "sss")
sumRow = Val(Mid(LFooter, myPos + 3, 2))
sFooter = 1
oldFooter = LFooter
ElseIf InStr(1, CFooter, "sss") > 0 Then
myPos = InStr(1, CFooter, "sss")
sumRow = Val(Mid(CFooter, myPos + 3, 2))
sFooter = 2
oldFooter = CFooter
ElseIf InStr(1, RFooter, "sss") > 0 Then
myPos = InStr(1, RFooter, "sss")
sumRow = Val(Mid(RFooter, myPos + 3, 2))
sFooter = 3
oldFooter = RFooter
Else
MsgBox _
"Nezadany stlpec pre kt. sa " _
& "majú sumy vyrátavat!!" _
& vbCrLf & vbCrLf & _
"Makro sa ukonci", , "SpPes ~ Summs"
Exit Sub
End If
Cells(1, sumRow).Select
Selection.End(xlDown).Select
myEndRow = Selection.Row
countPages = _
Worksheets(mySheet).HPageBreaks.Count


For i = 1 To countPages + 1
If i = 1 Then
myOldRow = 1
Else
myOldRow = myRow
End If
If i < countPages Or i = countPages Then
myRow = Worksheets(mySheet). _
HPageBreaks(i).Location.Row
Else
myRow = myEndRow + 1
End If
Set myRange = Range _
(Cells(myOldRow, sumRow), _
Cells(myRow - 1, sumRow))
answer = Format _
(Application.WorksheetFunction. _
Sum(myRange), "# ###.##")

Select Case sFooter

Case 1
Worksheets(mySheet).PageSetup.LeftFooter = _
Left(LFooter, myPos - 1) & " " & _
answer & " " & _
Right(LFooter, Len(LFooter) - myPos - 4)
Worksheets(mySheet).PrintOut i, i
Worksheets(mySheet).PageSetup.LeftFooter = oldF
Case 2
Worksheets(mySheet).PageSetup.CenterFooter = _
Left(CFooter, myPos - 1) & " " & _
answer & " " & _
Right(CFooter, Len(CFooter) - myPos - 4)
Worksheets(mySheet).PrintOut i, i
Worksheets(mySheet).PageSetup.CenterFooter = oldF
Case 3
Worksheets(mySheet).PageSetup.RightFooter = _
Left(RFooter, myPos - 1) & " " & _
answer & " " & _
Right(RFooter, Len(RFooter) - myPos - 4)
Worksheets(mySheet).PrintOut i, i
Worksheets(mySheet).PageSetup.RightFooter = oldF
End Select

Next

End Sub

-------------------end cut -------------------------------------

snad to pre niekoho bude......... :-)
ak to bude potrebne da sa to dorobit aj na hlavicky

-- 
s pozdravom
AleXXX

• Previous message: nefir: "Re: jak na cd s ochranou"
• Maybe in reply to: Graphics: "Tabulky v Excelu"
• Next in thread: Graphics: "Re: Tabulky v Excelu"
• Reply: Graphics: "Re: Tabulky v Excelu"
• Messages sorted by: [ date ] [ thread ] [ subject ] [ author ] [ attachment ]

This archive was generated by hypermail 2.1.2 : 22. 01. 2002, 13:36 CET