Määrätyn solualueen tulostaminen pdf-sivuna

Korjaus,
Varsinainen kysymykseni kuuluukin, miten saan tulostettua vaakasuunnassa yhdelle pdf:lle, kun tulostettava alue olisi AINA sama, eli alkaen aina solusta B2 30 saraketta ja B2 39 riviä.

Tee uusi tiedosto noilla tiedoilla ja tallenna se pdf.

Jäi mainitsematta, että jos tuon saisi siis VB:llä toteutettua, niin sille voisi luoda napin jolla kätevästi tulostaisi tuon pdf:n. Toki tiedän ja osaankin tehdä tuon ns. perinteisellä copy-pastettamallakin, mutta siinä pitää edelleen säätää ja viritellä muotoilut ym.. eli ei kätevä VB:llä painonapilla tehtyyn verrattuna. Kiitos kuitenkin vinkistä, mutta ei tällä kertaa houkutteleva vaihtoehto.

"väärinpäin "
#Tosin jos B-sarakkeeseen lisätään 30 saraketta, niin ollaan sarakkeessa AF, ja 2-riville 39 riviä, niin rivillä 40. Eli tuon koodissa olevan alueen muuttaisin muotoon "B2:AF40".#

- Totta, tarkkana saa olla. Laskiessani sarakkeita, mulla oli yksi "tarpeeton" sarake piilotettuna, eli näkymä on siis 32 saraketta ja 39 riviä.
Näkymän lisäksi on A- marginaalisarake ja rivi 1 -marginaalirivi, joita ei huomioida tulostukseen.

- Jos kalenteriani lähdetään laskemaan vuoden alusta, niin tarkasti laskien tuo "B2:AG40" -alue olisi ensimmäiset 4 viikkoa, jotka pitäisi tulostaa. Sen jälkeen tulostetaan seuraavat 4 viikkoa (28 solua), eli alkusolu on edelleen B2 31 saraketta, jolloin viimeisin sarake/rivi olisi BI40, eli edelliset 28 saraketta eivät näkyisi enää.

##Jos taas haluat tulostaa aina tietyn kokoisen alueen jostain solusta alkaen..##

- Juu kyllä, edelleen ajatukseni oli juuri tuo..

#"joku tyyliin "ActiveCell.Offset(39,30)""
Tai ei siis noin, koska tuo valitsee vain alueen oikean alanurkan. Ehkä pitää tehdä uusi range:
Dim rng as Range
Set rng = ActiveCell.Resize(39,30)
Tuupata toi rng sitten PrintAreaksi.
Resizestä: http://www.homeandlearn.org/the_resize_property.html#

- Tästä en oikein saanut kiinni..

Sub tulosta()
ActiveSheet.PageSetup.PrintArea = ""
'Jos kalenteriani lähdetään laskemaan vuoden alusta, niin tarkasti laskien tuo "B2:AG40" -alue olisi ensimmäiset 4 viikkoa, jotka pitäisi tulostaa.
'Sen jälkeen tulostetaan seuraavat 4 viikkoa (28 solua), eli alkusolu on edelleen B2 31 saraketta, jolloin viimeisin sarake/rivi olisi BI40, eli edelliset 28 saraketta eivät näkyisi enää.

'eka 4 viikkoa $E$1:$AG$40 Pane 2:ssa
'seuraavat 4 viikkoa kerroit olevan alkusolu on edelleen B2 31 saraketta, jolloin viimeisin sarake/rivi olisi BI40
'miksi ei ole sama eka ja toka ja mitern loput?
'nythän sen pitäisi olla $E$1: $B$I40
'jos sama niin silloin näin ja aina Pane2 vasen yläkulmasta lähtien
'korjaa taulukkoasia ja muuta arvot sopiviksi sitten...
ActiveSheet.PageSetup.PrintArea = ActiveWindow.Panes(2).VisibleRange.Cells(1, 1).Resize(40, 29).Address
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1
End Sub

Keep EXCELing
@Kunde

Moi kaikki jeesaajat, Kundea myöten.
Tilanne on hieman muuttunut, kun sain kaivettua käsiini vanhan viestin, jossa oli Kunden sorvaama koodi tälle kalenterilleni. Vanha kalenterini ei sisältänyt tätä koodia, joten kaivoin sen Excel-sivuston kätköistä. Ja kuinkas kävikään, sain sen toimimaan halutulla tavalla muutamaa lukua muuttamalla.
Vain aika näytää toimiiko tämä koodi luotettavasti koko vuoden, vai pitääkö jotain kohtaa viilata.

Kerran vielä Kaikille ja Kundellekin kiitos jeesistä!

Tässä alla kokonaisuudessaan tuo koodi.

Sub luo_pdf()
Dim x As Long
Dim Sarake As String
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Lomat2016").Activate
Range("B3") = Format(Date, "dd.mm.yyyy")
HaeEkasarake
ActiveWindow.Panes(2).Activate
x = ActiveWindow.Panes(2).ScrollColumn
If x > 26 Then
Sarake = Chr(Int((x - 1) / 26) 64) & Chr(((x - 1) Mod 26) 65)
Else
Sarake = Chr(x 64)
End If
Worksheets.Add().Name = "Huuhaa"
Worksheets("Lomat2016").Range("B2:B40").Copy Worksheets("Huuhaa").Range("A1")
Worksheets("Lomat2016").Range(Sarake & 2).Resize(39, 28).Copy Worksheets("Huuhaa").Range("B1")
Worksheets("Huuhaa").Columns(1).AutoFit
ActiveSheet.ResetAllPageBreaks
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
Set ActiveSheet.VPageBreaks(1).Location = Range("AG1")
ActiveWindow.View = xlNormalView
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.31496062992126)
.RightMargin = Application.InchesToPoints(0.31496062992126)
.Orientation = xlLandscape
.FitToPagesWide = 1
.FitToPagesTall = 1
.Zoom = 53
End With

Worksheets("Huuhaa").Range("A1:AG40").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:="D:\peedeeäffät\pdfkoe.pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
Worksheets("Huuhaa").Delete
Application.DisplayAlerts = True
End Sub

Sub HaeEkasarake()
Päiväys = Date
If weekDay(Date, vbMonday) = 6 Then
Haku = Format(Date - 1, "d.m.")
Päiväys = Päiväys - 1
Else
If weekDay(Date, vbMonday) = 7 Then
Haku = Format(Date - 2, "d.m.")
Päiväys = Päiväys - 2
Else
Haku = Format(Date, "d.m.")
End If
End If
With Range("E4:JD4")
Set Solu = .Find( _
What:=Haku, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not Solu Is Nothing Then
Set Löydetty = Solu
EkaOsoite = Solu.Address
Do
Set Löydetty = Union(Löydetty, Solu)

Set Solu = .FindNext(Solu)
Loop While Not Solu Is Nothing And Solu.Address <> EkaOsoite
End If
End With
End Sub