Forskellig markering i udskrifter!

Du skal bare lave den en x.kslde.com. deurrjf. skeidye; så virker det.

får jeg så point nu

lol ja det er svært at tage det ellers seriøse spørgsmål seriøst når det kommer fra ywltk

Hint: du skal bruge en do until loop og xlLastCell så meget vil jeg røbe, men det er for tæt på påskefri til at jeg gider at skrive den kode nu. Hvis ingen har hjulpet dig efter påske skal jeg nok lige smide noget sammen.

http://pmexcelent.dk/UdskrivFarve.xls

Fungere fint men vil du afsløre koden så jeg kan lære hvordan?

ok men det ligner 2 generation's kauderwelts :-)

Sub Udprint()

Dim t, t2, rk, rk2

Range("a1").End(xlDown).Activate
rk2 = ActiveCell.Row

For t = 1 To 100
If ActiveCell.Value <> "" Then
rk = rk + 1
End If
ActiveCell.Offset(1, 0).Activate
Next

Range("a1").End(xlDown).Activate

For t = 1 To rk
Range("a" & rk2 - 1 + t & ":c" & rk2 - 1 + t).Interior.ColorIndex = 6
Range("a" & rk2 - 1 + t - 1 & ":c" & rk2 - 1 + t - 1).Interior.ColorIndex = xlNone

For t2 = 1 To rk
'MsgBox ("") & ActiveCell.Value & ActiveCell.Offset(, 1).Value & ActiveCell.Offset(, 2).Value
ActiveCell.Offset(1, 0).Activate
Next
ActiveSheet.PrintOut
Range("a1").End(xlDown).Activate
Next
Range("a" & rk2 - 1 + t - 1 & ":c" & rk2 - 1 + t - 1).Interior.ColorIndex = xlNone
End Sub

Du må sige til hvis du skal have noget uddybet

Alternativt farver denne kun celler med indhold. Udskriver til vis udskrift, hvis det skal være til printer bruges linien ActiveSheet.PrintOut i stedet

   

Sub Farvogprint()

UsedRange.Interior.ColorIndex = 0
For Each RW In Range("a1", Range("a65536").End(xlUp))
    If RW.Row <> 1 Then
    Range("a" & RW.Row - 1, Range("iv" & RW.Row - 1).End(xlToLeft)).Interior.ColorIndex = 0
    End If
    If RW.Value <> "" Then
    Range("a" & RW.Row, Range("iv" & RW.Row).End(xlToLeft)).Interior.ColorIndex = 6
    'ActiveSheet.PrintOut    'udskriver til printer
    ActiveSheet.PrintPreview 'udskriver til vindue
    End If
Next
UsedRange.Interior.ColorIndex = 0
End Sub

Endnu et alternativ. Denne udskriver kun den aktuelle linie og skjuler alle andre.


Sub Farvogprint1()

UsedRange.Interior.ColorIndex = 0
For Each RW In Range("a1", Range("a65536").End(xlUp))
UsedRange.EntireRow.Hidden = True 'skjuler alle rækker
    If RW.Row <> 1 Then
    Range("a" & RW.Row - 1, Range("iv" & RW.Row - 1).End(xlToLeft)).Interior.ColorIndex = 0
    End If
    If RW.Value <> "" Then
    RW.EntireRow.Hidden = False 'hvis kun aktuel række skal udskrives
    Range("a" & RW.Row, Range("iv" & RW.Row).End(xlToLeft)).Interior.ColorIndex = 6
    'ActiveSheet.PrintOut    'udskriver til printer
    ActiveSheet.PrintPreview 'udskriver til vindue
    End If
Next
UsedRange.Interior.ColorIndex = 0
UsedRange.EntireRow.Hidden = False
End Sub

Hvor langt er vi nået ?

Jamen det virker fint! Jeg har dog desværre ikke haft tid til at arbejde videre med det.
Så det er tid til point :-)

ok

Du får lige den nyeste version også, du kan udvide antal kolonner
som farves ved at ændre "c" til den kolonne du ønsker i linierne med '**
Udskift PrintOut med PrintPreview hvis det skal være på papir

Sub Marker()

Dim rk
Range(Range("a1").End(xlDown), Range("a65536").End(xlUp)).Select
For Each rk In Selection
If rk <> "" Then
Range("a" & rk.Row, Range("c" & rk.Row)).Interior.ColorIndex = 6 '**
ActiveSheet.PrintPreview ' PrintOut
Range("a" & rk.Row, Range("c" & rk.Row)).Interior.ColorIndex = xlNone '**
End If
Next

End Sub

Jeg har nu implementeret makroen ind i mit regneark! Da regnearket er opdelt i flere ens ark (12 stk)! Indtil videre bliver jeg nød til at lave en makro for hver ark! hvordan laver en makro der udskriver alle 12 ark?? (NB! det er første gang jeg arbejder med VB)

Sub Marker()

Dim sh As Worksheet
Dim rk

For Each sh In ActiveWorkbook.Worksheets
sh.Activate

Range(Range("a1").End(xlDown), Range("a65536").End(xlUp)).Select
For Each rk In Selection
If rk <> "" Then
Range("a" & rk.Row, Range("c" & rk.Row)).Interior.ColorIndex = 6 '**
ActiveSheet.PrintPreview ' PrintOut
Range("a" & rk.Row, Range("c" & rk.Row)).Interior.ColorIndex = xlNone '**
End If
Next

next
End Sub

Jeg har lagt den ind i mit excel ark! Men ved ark nr. 2 får jeg en fejl 400! Nogen ide til problemet?!

Hej ywltk. er på job lige nu, men når jeg er hjemme skal jeg nok kikke på det.
Husk lige at klikke på boxen med mit navn, og klik accepter

Har kørt en test igen her, jeg får ikke nogen fejl

hvilken linie stopper makro i, og hvad er fejl teksten ?

Hmm! Jeg havde lavet en fejl beklager ulejligheden! Det fungerer perfekt nu!

Nå ja jeg har dog fået ondt i armene da jeg ikke kan få dem ned af ren begejstring! :-)
Tak for hjælpen!