Printen vaste kolom + variabele kolom

Status
Niet open voor verdere reacties.

Ron001

Gebruiker
Lid geworden
4 dec 2017
Berichten
384
Allen

Ik zou tussen 04h00 en 13h00 de namen van de vroege ploeg (06 – 14) willen printen + daarachter de huidige dag.
Onder de namen van de vroege ploeg ook de kolom “Overige” namen + de huidige dag.

Dus Range (A17:D35) + huidige dag (voorbeeld: maandag => Range (F14:I35))
Kolom “Overige” is Range (A70:D75) + huidige dag (voorbeeld: maandag => Range (F70:I75))

In bijlage ook nog een voorbeeld wat het zou moeten worden.

Alvast bedankt!



 

Bijlagen

  • test.xlsm
    42,6 KB · Weergaven: 40
  • voorbeeld.docx
    44,2 KB · Weergaven: 40
Laatst bewerkt door een moderator:
Wil iemand me op weg zetten...
Hoe ik de "vaste" kolom en de variabele aan elkaar kan printen?

Bedankt!
 
Zo?
Code:
Sub hsv()
Dim rw
rw = Application.Match(CLng(Date), Rows(14), 0)
If Not IsError(rw) Then
  Columns("F:AD").Hidden = True
  Columns(rw).Resize(, 4).EntireColumn.Hidden = False
  ActiveSheet.PrintPreview
  Columns("F:AD").Hidden = False
End If
End Sub
 
Laatst bewerkt:
Bijna

Alleen zou rij 14 & 15 (deze dag/datum zou ik vanboven in de header willen verplaatsen) 36 & 37 en rij 60 & 61 niet mee geprint mogen worden en zou aansluitend op rij 35 de rijen 62 tot 75 moeten komen
 
Code:
Sub Macro1()
'
' Macro1 Macro
'

'
    Rows("23:23").Select
    Selection.Delete Shift:=xlUp
End Sub

Deze gaan gebruiken? EntireRow.Delete?
 
Code:
Sub hsv()
Dim rw
rw = Application.Match(CLng(Date), Rows(14), 0)
If Not IsError(rw) Then
  Columns("F:ad").Hidden = True
  Rows(14).Hidden = True
  Rows(15).Hidden = True
  Columns(rw).Resize(, 4).EntireColumn.Hidden = False
  ActiveSheet.PrintPreview
  Columns("F:ad").Hidden = False
  Rows(14).Hidden = False
  Rows(15).Hidden = False
End If
End Sub

Werkt inderdaad :)
Maar hoe verplaats ik de datum naar de (gecentreerde) header?
 
Dit bedoel je?
Code:
Sub hsv()
Dim rw
With ActiveSheet
rw = Application.Match(CLng(Date), .Rows(14), 0)
  If Not IsError(rw) Then
    .Columns("F:ad").Hidden = True
    .Rows("14:15").Hidden = True
    .Columns(rw).Resize(, 4).Hidden = False
    .PageSetup.CenterHeader = "&d"
    .PrintPreview
    .Columns("F:ad").Hidden = False
    .Rows("14:15").Hidden = False
  End If
End With
End Sub
 
Dat bedoel ik, alleen nog lange tijdsnotatie bv=> Maandag 21 augustus

Waarom loopt de code fout als ik extra rijen toevoeg bij ".Rows.Hidden"

Code:
.Rows("14:15:36:37:60:61").Hidden = True
Als er enkel rij 14 en 15 staat werkt dit wel...
 
Kijk even na in je VBA handboek.

Of neem een macro op met deze rijen geselecteerd.
 
kommas plaatsen
Code:
.Range("14:15,36:37,60:61").EntireRow.Hidden = True
Code:
 .PageSetup.CenterHeader = Format(Date, "dddd dd-mm-yyyy")
 
Laatst bewerkt:
Heb nog vanalles aan het proberen geweest…

• Ik maak bij het printen de lege cellen wit, maar hoe krijg ik deze dan na de print in de file terug op de originele kleur, nu blijven deze wit…
• Bij het printen moet deze maar beginnen op A16, nu wordt het jaartal en de week ook mee afgeprint.
• Hoe kan ik een afbeelding (in dit geval de print) “evenwijdig” uitrekken, breedte en hoogte zodat afbeelding niet vervormd? Met FitToPages? Mij lijkt de afbeelding zich alleen op heel het blad te positioneren met de Zoom…

Code:
Sub hsv()
Dim rw
With ActiveSheet
rw = Application.Match(CLng(Date), .Rows(14), 0)
  If Not IsError(rw) Then
    .Columns("F:ad").Hidden = True
    .Range("14:15,36:37,60:61").EntireRow.Hidden = True
    .Columns(rw).Resize(, 4).Hidden = False
    .PageSetup.CenterHeader = Format(Date, "dddd dd-mm-yyyy")
    '.PageSetup.CenterHeader = "&d"
    '.PageSetup.Zoom = 70
    .PageSetup.FitToPagesTall = 1
    .PageSetup.FitToPagesWide = 1
    .PageSetup.CenterVertically = True
    .PageSetup.CenterHorizontally = True
    .PageSetup.Orientation = xlPortrait
    .PageSetup.PaperSize = xlPaperA4
            With Range("f17:AB75")
            .SpecialCells(4).Interior.Color = xlNone
           ' .PrintOut , Copies:=1
        End With
    '.PageSetup.HorizontalAlignment = xlCenter
    '.PageSetup.VerticalAlignment = xlCenter
    .PrintPreview
    .Columns("F:ad").Hidden = False
    .Range("14:15,36:37,60:61").EntireRow.Hidden = False
  End If
End With
End Sub
 
2e vraagje, kijk waar je printpreview staat, die verwijst naar je activesheet, niet naar range("F7:AB75"), dus die moet daar 2 regels onder staan ipv die geinactiveerde printout.
3e vraag, dat ligt moeilijk om dat te automatiseren, die pagesetup.zoom (nu geinactiveerd) van 70, daar moet je mee spelen, maak daar anders eens 90 of 110 van.
1e vraag, stop de kleur van je lege cellen in een variabele, print af, en restore daarna je kleuren
Code:
kleur = .SpecialCells(4).Cells(1).Interior.Color
.SpecialCells(4).Interior.Color = xlNone
.... stukje programma
.SpecialCells(4).Interior.Color = kleur
 
Laatst bewerkt:
Ivm 2de vraag, als ik deze daar zet valt de vaste kolom er toch af? Neemt hij enkel die Range in PrintPreview...
 
ivm. die kleuren, alle gewenste data kopieren naar een nieuw blad, uitprinten en daarna blad weer verwijderen
Code:
Sub hsv2()
    Dim rw, shCopy, shPaste
    Set shCopy = ActiveSheet
    With shCopy
        rw = Application.Match(CLng(Date), .Rows(14), 0)
        rw = Application.Match(CLng(DateSerial(2018, 1, 2)), .Rows(14), 0) '<--- om de datum te doen kloppen !!!

        If Not IsError(rw) Then
            .Columns("F:ad").Hidden = True
            .Range("14:15,36:37,60:61").EntireRow.Hidden = True
            .Columns(rw).Resize(, 4).Hidden = False
            Set shPaste = Sheets.Add
            shCopy.Range("A17:D75").SpecialCells(xlCellTypeVisible).Copy
            shPaste.Range("A1").PasteSpecial Paste:=xlPasteAll       'probleempje met samengevoegde cellen !!!
            shCopy.Range("F17:AB75").SpecialCells(xlCellTypeVisible).Copy
            shPaste.Range("E1").PasteSpecial Paste:=xlPasteAll
            With shPaste
                .UsedRange.SpecialCells(4).Interior.Color = xlNone
                With .PageSetup
                    .CenterHeader = Format(Date, "dddd dd-mm-yyyy")
                    .CenterVertically = True
                    .CenterHorizontally = True
                    .Orientation = xlPortrait
                    .PaperSize = xlPaperA4
                    .FitToPagesTall = 1
                    .FitToPagesWide = 1
                    .Zoom = False
                    .HeaderMargin = 10
                    .TopMargin = 25
                    .BottomMargin = 10
                End With
                .PrintPreview
            End With
            Application.DisplayAlerts = False
            shPaste.Delete
            Application.DisplayAlerts = True
            .Columns("F:ad").Hidden = False
            .Range("14:15,36:37,60:61").EntireRow.Hidden = False
        End If
    End With
End Sub
 
Laatst bewerkt:
Kan ook:
Code:
.CenterHeader = Format(Date, "long date")
 
:thumb:, zo leer je nog eens iets.
 
@ Cow
Super bedankt voor de moeite, heb uw code proberen te lezen (wat me lukt in stukken ).
Maar als ik de macro uitvoer doet deze niets bij mij, ligt waarschijnlijk aan mij?
 
zie bijlage, alleen kom ik even zelf voor een probleem te staan.
de macro "cow18" kan ik nu plots niet meer aanroepen.
Dus dan maakte ik de macro "cow" die enkel "cow18" aanroept, bizar.
Maar nu hab ik geen tijd meer om het uit te zoeken.
 

Bijlagen

  • test (6).xlsm
    48,1 KB · Weergaven: 30
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan