dotNETportal.cz

Jistě že úlohu lze řešit a to s použitím VBA (tedy ne "Off Topic" ale "Visual Basic 6 a jiné verze"

A není ani potřeba s Excelem zas tak moc umět, jak je tu zmíněno. Stačí znát základy programování, použít záznam maker a trochu upravit a doplnit.

Jde je o to oblast s 30 řádky z List2 (od zadaného řádku) překopírovat do List1 od řádku 7 (jen hodnoty, bez formátu) a zvolenou oblast tisku poslat na tiskárnu. To vše dát do opakovacího cyklu podle zadaného počtu stránek.

Toto je základ - zaznamenané makro podle popisu výše a snímku, jak stránka vypadá:

Sub Makro1()
'
' Makro1 Makro
' Makro zaznamenané 12.6.2012
'
    Range("A1:T30").Select
    Selection.Copy
    Sheets("List1").Select
    Range("A7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

A po odstranění Select (není potřeba) a doplnění o potřebné proměnné:

Public Sub ZkusTo()
  ' existuje Sešit1 s List1 a List2
  ' na List1 jsou v oblasti "$A$1:$T$53" data k tisku...
  '    - nastavení sešitu k tisku a nastavení tiskárny neřeším
  ' na List1 v buňce V1 je číslo řádku, od kterého začne vkládání pro tisk
  ' na List1 v buňce V2 je číslo opakování tisku
  ' na List2 jsou od A1 data pro vkládání po 30 řádcích do List1 od řádku 7
  Dim i As Integer
  Dim OdRadku As Integer
  Dim PocetStranek As Integer
  Dim OblastProCopy As Range ' adresa oblasti pro kopírování
  Dim Adresa As String  ' pro sestavení adresy oblasti pro kopírování
  Const PocetRadku As Integer = 30 ' počet řádků pro kopírování
  Dim Strana As Integer, StranCelkem As Integer
  ' načtení vstupních hodnot:
  OdRadku = Sheets("List1").Range("V1").Value
  PocetStranek = Sheets("List1").Range("V2").Value
  Sheets("List1").Range("M2").Value = Date
  Strana = (OdRadku - 1) / 30 + 1
  StranCelkem = PocetStranek + Strana - 1
  For i = 1 To PocetStranek
    Sheets("List1").Range("T1").Value = Strana & " / " & StranCelkem
    Adresa = "A" & OdRadku & ":T" & OdRadku + PocetRadku - 1
    Sheets("List2").Range(Adresa).Copy
    Sheets("List1").Range("a7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    OdRadku = OdRadku + PocetRadku
    Strana = (OdRadku - 1) / 30 + 1
    Tisk
    DoEvents
  Next
End Sub

'---------------
Sub Tisk()
'
' Makro zaznamenané 12.6.2012
' Cíl tisku jsem na zkoušku zvolil místo tiskárny utilitu "FinePrint"
'
    Application.CutCopyMode = False
    Application.ActivePrinter = "FinePrint na FPR6:"
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
        "FinePrint na FPR6:"
End Sub