12. juni 2008 - 13:13Der er
6 kommentarer og 1 løsning
Tekstboks eller integerWord i et ark, der tilgodeser sideskift.
Jeg har et ark, der fungerer som et standardiseret skema baseret på udskrivning efter udfyldelse. Kolleger uden særligt kendskab til regneark eller tekstbehandling skal udfylde skemaet.
På den første tredjedel af side 1 (øverst på arket) er et område, der skal udfyldes ved afkrydsning. På Resten af side 1 og de kommende sider skal der være plads til, at man kan skrive som i et worddokument.
Mit problem er, at når jeg indsætter en tekstboks eller Word som et objekt, bliver der ikke taget højde for sideskift på en udskrift. Tekst forsvinder simpelthen. Desuden tages der ikke højde for angivelse af udskriftsområde.  Jeg vil gerne undgå, at mine kolleger selv skal til at indsætte nye tekstbokse og angive udskriftsområde.
Jeg kan ikke lave det i et worddokument, selvom det nok lyder mest nærliggende, fordi skemaet øverst på side 1 bliver udfyldes ved hjælp af en masse beregninger i andre ark.
Mit eget bedste bud er, at jeg indsætter 5 tekstbokse, 1 til hver side og angiver udskriftsområde til 5 sider, men det giver det problem, at hvis der kun bliver skrevet på 2 sider, bliver der stadig printet 5 sider ud.
Hvordan kan man tage højde for dette, og helst uden makro, da jeg med stor besvær har undgået det indtil nu i arket.
Rem SIDESKIFT SKAL VÆRE INDSAT MELLEM DE ENKELTE TEKSTBOKSE Rem ======================================================= Rem KODEN INDSÆTTES I THISWORKBOOK Rem ============================== Sub klargørTilUdskrift() Dim cc As Shape, antalTekstBokse, antalTegn, HPræk
Rem udskriver kun, hvis B1 er udfyldt If ActiveSheet.Range("B1") <> "" Then
antalTekstBokse = ActiveSheet.Shapes.Count
Rem dummy-opsætning ActiveSheet.PageSetup.PrintArea = "$B$1:$F500" 'Skønnet maximum
If antalTekstBokse > 0 Then For tb = 1 To antalTekstBokse With ActiveSheet.Shapes(tb) navn = .Name
Set cc = ActiveSheet.Shapes(navn) cc.Select antalTegn = Len(Selection.Text)
If antalTegn = 0 And tb > 1 Then Rem hvilken række er der sideskift HPræk = ActiveSheet.HPageBreaks(tb - 1).Location.Row ActiveSheet.PageSetup.PrintArea = "$B$1:$F$" & CStr(HPræk - 1) udSkriv Exit Sub End If End With Next tb End If
Rem alle tekstbokse udfyldt - tilpas sideopsætning HPræk = ActiveSheet.HPageBreaks(antalTekstBokse).Location.Row ActiveSheet.PageSetup.PrintArea = "$B$1:$F$" & CStr(HPræk - 1)
udSkriv End If End Sub Private Sub udSkriv() ActiveSheet.PrintOut End Sub
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
