Thomas
Funktionen bliver automatisk aktiveret, når du vælger udskriv eller
trykker på Udprint-knappen.
Jeg har vedhæftet min testopstilling til en personlig mail. Hvis du
stadig ikke kan få det til at virke, er du velkommen til at vedhæfte
en kopi af projektmappen og maile den til mig privat. Hvis filen
fylder mere end 100KB, vil jeg sætte pris på, at du zipper den først
Med venlig hilsen
LeoH
"TM" <tm@navalyard.dk> skrev i en meddelelse
news:9g55md$j7p$1@news.inet.tele.dk...
> > Som ved Haralds løsning skal koden indsættes i ThisWorkbook.
> > Gå til VBA-editoren med <Alt><F11> og dobbeltklik på ThisWorkbook
> > i øverste venstre vindue. Kopier og indsæt nedenstående rutine og
> > skriv selv de aktuelle værdier for SheetName og CheckRow.
> >
> > Med venlig hilsen
> > LeoH
> >
> > Private Sub Workbook_BeforePrint(Cancel As Boolean)
> > 'leo.heuser@get2net.dk, 12. juni 2001
> > Dim SheetName As String
> > Dim CheckRow As Long
> > Dim Cell As Range
> >
> > SheetName = "Ark1"
> > CheckRow = 1
> >
> > On Error GoTo Finito
> > With ActiveSheet
> > If .Name = SheetName Then
> > With Application
> > .ScreenUpdating = False
> > .EnableEvents = False
> > End With
> > .Columns.Hidden = True
> > For Each Cell In Rows(CheckRow).Cells
> > If Cell.Value = 1 Then
> > Cell.EntireColumn.Hidden = False
> > End If
> > Next Cell
> > .PrintOut
> > .Columns.Hidden = False
> > Cancel = True
> > End If
> > End With
> >
> > Finito:
> > With Application
> > .ScreenUpdating = True
> > .EnableEvents = True
> > End With
> > Set Cell = Nothing
> > End Sub
> >
> > ----------------------------
> >
> >
> Leo. Jeg har kopieret koden ind i ThisWorkbook og ændret "Ark1" til
"Navne"
> som mit ark hedder jeg har indsat nogle 1 taller vilkårlige steder i
række
> 1 men jeg synes ikke der sker noget den skriver stadig det hele ud hvordan
> aktivere jeg den funktion.
>
> Med venlig hilsen
> Thomas
>
>