Makro og VBA - Knap til print

Print side | Luk vindue

Knap til print

Udskrevet fra: Dansk Regneark Forum
Kategori: Hjælp til regneark.
Forum navn: Makro og VBA
Forum beskrivelse: Hjælp til Makroer og VBA-programmering
Web-adresse: https://forum.excel-regneark.dk/forum_posts.asp?TID=245
Udskrevet den: 23.Nov.2024 kl. 16:06

Emne: Knap til print

Besked fra: kbno
Emne: Knap til print
Posteringsdato: 15.Feb.2011 kl. 13:20

Jeg har et regneark med 3 faner. På fane 3 er det en rapport som skabes ved indtastninger på de 2 første faner.

Så er det jeg godt kunne tænke mig en knap eller lign. funktion på fane 2 som udskriver rapporten fra fane 3, og evt. gemmer den som pdf.

Håber i kan hjælpe

-------------
Hygge - Kim
Excel 365 DK user

Svar:

Besked fra: Allan
Posteringsdato: 15.Feb.2011 kl. 13:45

Hej Kim,

Prøv lige denne, den virker i Excel 2007 og frem.

Du skal lave lidt justeringer på koden inden du kan bruge den.

ArkNavn = Navnet på det ark du vil gemme/printe

DataSti = Hvor du vil gemme filen, husk \ til sidst

FilNavn = Navnet på din pdf

Option Explicit
Sub Udskriv_og_Gem_Som_pdf()

Dim ArkNavn, DataSti, Filnavn As String

ArkNavn = "Ark2" 'Navnet på den fane som skal udskrives
DataSti = "C:\Test\" 'Der hvor filen skal gemmes, husk at afslutte med \
Filnavn = "test.pdf"

'Printer det aktive ark
Sheets(ArkNavn).PrintOut

'Gemmer det aktive ark som .pdf
Sheets(ArkNavn).ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=DataSti & Filnavn, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
End Sub

//Allan

Besked fra: kbno
Posteringsdato: 15.Feb.2011 kl. 17:34

hmmm er lidt i tvivl hvor jeg skal taste det ind. Har nu forsøgt med både en activeX knap og en Kontrolelement for formular knap.

Begge giver desværre en fejl.

Compile error:

Invalid inside procedure.

Ska lige nlvnes at jeg sidder herhjemme på min Excel 2010 DK.

-------------
Hygge - Kim
Excel 365 DK user

Besked fra: Allan
Posteringsdato: 15.Feb.2011 kl. 18:14

Hej Kim,

Prøv lige om denne fil giver samme fejl?

/uploads/1/gem_pdf_og_udskriv.xls - uploads/1/gem_pdf_og_udskriv.xls

//Allan

Besked fra: kbno
Posteringsdato: 15.Feb.2011 kl. 20:20

Hmmm jeg jokker lidt rundt i det der VBA editor. Jeg har fået den til at du med formlen i dit eksempel. Men lige pludselig kan jeg ikke deaktiverer knap og så virker den pludselig ikke og giver besked om at makroen ikke er tilgængelig.

Jeg prøver at arbejde videre på det og se om ikke jeg kan finde hoved og hale i dette VBA halløjsa Confused

btw - som en lille side bemærkning - kan man ikke svare indlæg i den nye MSIE 9.0 Beta Ouch

-------------
Hygge - Kim
Excel 365 DK user

Besked fra: kbno
Posteringsdato: 15.Feb.2011 kl. 20:44

Ja så tror jeg faktisk det lykkes. Har endda delt den op i 2 knapper. 1 til Gem som PDF og en til Print.

Kan man lave en "Gem Som" funktion ???

Endnu engang 10000000000000000000 tak for hjælpen Beer

-------------
Hygge - Kim
Excel 365 DK user

Besked fra: Allan
Posteringsdato: 15.Feb.2011 kl. 21:10

Hej Kim,

Jeg kender godt fejlen i IE9 beta og textboxe, det samme var gældende i IE8 mens den var i beta, Microsoft løste problemet i den endelige version, jeg håber det også er tilfælde denne gang

ellers må jeg til tasterne.

Du skriver 'Gem som' funktion, mener du at man selv skal kunne vælge filnavnet på pdf'en?

//Allan

Besked fra: kbno
Posteringsdato: 15.Feb.2011 kl. 21:45

Ja - jeg er nemlig bange for at min kone som skal bruge arket ender med IKKE at kunne finde det igen - hun er langtfra super bruger. Embarrassed

-------------
Hygge - Kim
Excel 365 DK user

Besked fra: Allan
Posteringsdato: 16.Feb.2011 kl. 10:53

Hej igen,

Jeg har lavet en boks hvor i du kan angive det ønskede navn på filen, boksen fortæller også hvor filen gemmes.

På denne måde kan du styre hvor filerne gemmes hver gang, din kone bestemmer navnet på filen.

Vi kan naturligvis også 'bare' vise Excel's egen 'Gem som' dialogboks... jeg ved ikke helt hvad du foretrækker.

Kig på denne: /uploads/1/gem_pdf_og_udskriv.xls - uploads/1/gem_pdf_og_udskriv.xls

//Allan

Besked fra: kbno
Posteringsdato: 16.Feb.2011 kl. 16:07

Hej Allan

Jeg har tænkt mere over det og kommet frem til følgende.

Jeg har en celle med uge nummer. Kunne man f.eks lave "Gom Som" knappen så den får følgende sti:

%Userprofile%/Dokumenter/Menuplan/menuplan_"celleA1".pdf

Så den gemmer dokumentet under brugerens dokument folder, uanset brugernavn og så hente filenavnet (ugfe nummer) fra f.eks. celle A1.

Ved ikke lige om det blev så let forståeligt.

Hygge - Kim

-------------
Hygge - Kim
Excel 365 DK user

Besked fra: Allan
Posteringsdato: 16.Feb.2011 kl. 17:24

Hej Kim,

Lad os se om denne kan klare det: uploads/1/gem_pdf_og_udskriv2.xls - uploads/1/gem_pdf_og_udskriv2.xls

Den gemmer pdf'en i mappen 'Dokumenter' hos den bruger som er logget ind.

Mappen 'Menuplan' oprettes som undermappe til 'Dokumenter' hvis den ikke findes i forvejen.

Filnavnet bliver 'Menuplan_' + indholdet af A1 på det ark som gemmes + naturligvis .pdf.

ps. jeg skal nok svare din besked og opdatere din fil med koden.

Er vi ved at være i mål?

//Allan

Besked fra: rassten
Posteringsdato: 16.Feb.2011 kl. 18:46

= objFolders("mydocuments")... Se, det er flot stykke kode!

Jeg har tidligere haft samme problem, og var nød til at bruge "Sendkeys"
Sub a_test()
'VBA-editor må ikke være aktiv vindue når under sendkeys
SendKeys "{F12}"
End Sub
Og den metode har jeg lige så meget i mod, som at bruge betinget formatering.

-------------
VH rassten

Arbejde excel 2010
Privat excel 2010

Besked fra: Allan
Posteringsdato: 16.Feb.2011 kl. 21:13

Du har fuldstændig ret rassten, Sendkeys er noget hø.

Jeg har selv haft en del scheduled jobs i Excel som kørte med SendKeys, pludselig var der en som skrev til mig via MSN messenger..... behøver jeg sige mere...

Jeg har en lille samling som jeg naturligvis gerne deler, jeg ved ikke om du kan bruge den, men jeg synes de er guld værd

Sub SpecialMappeNavne()
Dim objFolders As Object
Set objFolders = CreateObject("WScript.Shell").SpecialFolders

Range("A1") = objFolders("desktop")
Range("A2") = objFolders("allusersdesktop")

Range("A3") = objFolders("favorites")
Range("A4") = objFolders("mydocuments")

Range("A5") = objFolders("sendto")
Range("A6") = objFolders("Recent")

Range("A7") = objFolders("startmenu")
Range("A8") = objFolders("allusersstartmenu")

Range("A9") = objFolders("Startup")
Range("A10") = objFolders("AllUsersStartup")

Range("A11") = objFolders("Templates")
Range("A12") = objFolders("Fonts")

Range("A13") = objFolders("Programs")
Range("A14") = objFolders("AllUsersPrograms")

Range("A15") = objFolders("NetHood")
Range("A16") = objFolders("PrintHood")

End Sub

Besked fra: kbno
Posteringsdato: 16.Feb.2011 kl. 21:42

Allan skrev:

Hej Kim,

Er vi ved at være i mål?

//Allan

Jeps og lidt længere Thumbs Up

1000000000000 tak for hjælpen endnu engang Beer

-------------
Hygge - Kim
Excel 365 DK user

Besked fra: Allan
Posteringsdato: 16.Feb.2011 kl. 22:05

Velbekomme Kim, tak for tilbagemeldingen.

//Allan

-------------
MVH

Allan
https://www.excel-regneark.dk" rel="nofollow - Excel-regneark.dk - Gratis skabeloner til Excel
Få over 120 ekstra funktioner med Danmarks bedste add-in

Besked fra: rassten
Posteringsdato: 16.Feb.2011 kl. 22:08

Jeg siger også tak,
fin samling.
Specielt
Range("A1") = objFolders("desktop")
Range("A2") = objFolders("allusersdesktop")
var dem som jeg havde brug for!

-------------
VH rassten

Arbejde excel 2010
Privat excel 2010

Besked fra: rassten
Posteringsdato: 16.Feb.2011 kl. 22:11

Altså uden range

objFolders("desktop")
objFolders("allusersdesktop")

jeg kunne ikke genne fil til desktop, uden at kende den speciel sti på andre computere

-------------
VH rassten

Arbejde excel 2010
Privat excel 2010

Besked fra: Allan
Posteringsdato: 16.Feb.2011 kl. 22:12

Velbekomme, dejligt jeg kunne hjælpe dig rassten.

//Allan

Besked fra: kbno
Posteringsdato: 17.Feb.2011 kl. 09:43

Hej Alllan

Nu har jeg lige åbnet det på arbejde og så kommer der en debugger fejl. Det er følgende der skulle være problemer med.

'Gemmer det aktive ark som .pdf
Sheets(ArkNavn).ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=DataSti & Filnavn, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False

Eneste forskel siden testen i går aftes er versionen af excel - jeg bruger excel 2010 derhjemme og har både en version 2003 + 2007 på arbejde, og ingen af dem virker.

Hjælpppp

-------------
Hygge - Kim
Excel 365 DK user

Besked fra: Allan
Posteringsdato: 17.Feb.2011 kl. 10:03

Problemet er at Excel 2003 ikke har indbygget 'Gem som pdf'

2007 kan godt, den skal bare opdateres for at kunne gemme som pdf, brug denne opdatering fra Microsoft: http://www.microsoft.com/downloads/da-dk/details.aspx?displaylang=da&FamilyID=4d951911-3e7e-4ae6-b059-a2e79ed87041 - http://www.microsoft.com/downloads/da-dk/details.aspx?displaylang=da&FamilyID=4d951911-3e7e-4ae6-b059-a2e79ed87041

//Allan

Besked fra: kbno
Posteringsdato: 17.Feb.2011 kl. 15:38

Jeps - der lå fejlen havde lige glemt at den bærbare var reinstalleret og endnu ikke havde fået lagt alting på

DOH

Endnu engang tak for assistancen

-------------
Hygge - Kim
Excel 365 DK user

Besked fra: kbno
Posteringsdato: 17.Feb.2011 kl. 18:12

Ja så kom der alligevel et spørgsmål eller 2 Clown

Kan man gøre ovenstående dropdown menu længere ???? Hendes liste er nemlig LANGGGG

og så lige en hurtig - kan man lave en knap til GemsomWord - har selv forsøgt at ændre div. "pdf" til "doc" eller "docx" dog uden det lykkedes Ouch

-------------
Hygge - Kim
Excel 365 DK user

Besked fra: rassten
Posteringsdato: 17.Feb.2011 kl. 22:20

blot et forslag


Sub a_test()
    
    Dim wdApp As Object
    Dim wdDoc As Object
    
    Set wdApp = GetObject("", "Word.Application")
    
   ' wdApp.Visible = True
   ' fjern "'" hvis du vil se Word åbne
    
    Set wdDoc = wdApp.Documents.Add
    
    ActiveWindow.DisplayGridlines = False
    ' ellers bliver gridlines kopieret over på word
    
    Range("a1:f25").Copy
    
    wdApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteText, _
    Placement:=wdInLine, DisplayAsIcon:=False
    
    
   ' wdApp.Visible = False
    ' fjern "'" hvis du vil se Word lukke
    
    On Error Resume Next
   ' B1 er en celle med dato, men det kan du gøre som du vil
     wdApp.activedocument.SaveAs "C:\" & "Menu " & Format(Range("B1").Value, "dd-mm-yy") & ".doc"
    
    
    ActiveWindow.DisplayGridlines = True

    Set wdApp = Nothing
    Set wdDoc = Nothing
End Sub

-------------
VH rassten

Arbejde excel 2010
Privat excel 2010

Besked fra: rassten
Posteringsdato: 17.Feb.2011 kl. 23:44

Jeg vil gerne lave slutningen lidt om, ellers skulle word vist nok stadig være i hukommelsen


   On Error Resume Next
   ' B1 er en celle med dato, men det kan du gøre som du vil
     wdApp.activedocument.SaveAs "C:\" & "Menu " & Format(Range("B1").Value, "dd-mm-yy") & ".docx"
    
    wdApp.documents.Close savechanges:=wddonotsavechanges
    
    
    wdApp.Quit
 

    Set wdApp = Nothing
    Set wdDoc = Nothing
    
    ActiveWindow.DisplayGridlines = True
    Application.CutCopyMode = False

    
End Sub

-------------
VH rassten

Arbejde excel 2010
Privat excel 2010

Besked fra: kbno
Posteringsdato: 18.Feb.2011 kl. 07:09

OK det virkede til dels - nu skal filen bare gemme det rigtige ark og det rigtige sted.

Som din kodning er nu, gemmer den i roden af C drev og så gemmer den det ark som er aktivt. De linier jeg skal have implenteret er følgende:

DataSti = objFolders("mydocuments") & "\MenuPlan\"
Filnavn = "Menuplan_uge" & Sheets(ArkNavn).Range("A1").Value

-------------
Hygge - Kim
Excel 365 DK user

Besked fra: rassten
Posteringsdato: 18.Feb.2011 kl. 22:48

Mit tidligere indlæg var ikke et forsøg på at overtage tråden fra Allan, men blot et forslag.


Sub b_test()

    Dim wdApp As Object
    Dim wdDoc As Object
    
        'Fra Allan
        '
        Dim ArkNavn, DataSti, Filnavn As String
        Dim objFolders As Object
        Set objFolders = CreateObject("WScript.Shell").SpecialFolders

        'Ark2 udskiftes alle steder med det Ark som skal bruges - word vil kun kopiere fra det aktive ark
        DataSti = objFolders("mydocuments") & "\MenuPlan\" 'Der hvor filen skal gemmes, husk at afslutte med \
        Filnavn = "Menuplan_" & Sheets("Ark2").Range("A1").Value & ".docx"

        'Tjekker om mappen 'DataSti' eksisterer, hvis ikke oprettes den
        If Dir(DataSti, vbDirectory) = "" Then
            MkDir DataSti
        End If

    Application.ScreenUpdating = False
    
    Set wdApp = GetObject("", "Word.Application")
    
    Set wdDoc = wdApp.documents.Add
     
    Worksheets("Ark2").Activate 'word vil kun kopiere fra det aktive ark
    ActiveWindow.DisplayGridlines = False
    ' ellers bliver gridlines kopieret over på word
    
    Range("a1:f25").Copy
    'det kan kun være det kopieret område som overføres til word
    wdApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteText, _
    Placement:=wdInLine, DisplayAsIcon:=False
    
    
    
    'Slette filen hvis den allerede findes
    On Error Resume Next
    Kill DataSti & Filnavn
    
    On Error Resume Next
    wdDoc.SaveAs DataSti & Filnavn

    wdApp.documents.Close savechanges:=False
    
    On Error GoTo 0

    wdApp.Quit
 

    Set wdApp = Nothing
    Set wdDoc = Nothing
    
    ActiveWindow.DisplayGridlines = True
    Application.CutCopyMode = False

    Worksheets("Ark1").Activate
    Application.ScreenUpdating = True
End Sub

-------------
VH rassten

Arbejde excel 2010
Privat excel 2010

Besked fra: kbno
Posteringsdato: 19.Feb.2011 kl. 10:26

Jeg synes i begge er seje og modtager gerne input fra begge Beer

Desværre giver ovenstående denne debug fejl.

Filnavn = "Menuplan_" & Sheets("Ark2").Range("A1").Value & ".docx"

-------------
Hygge - Kim
Excel 365 DK user

Besked fra: rassten
Posteringsdato: 19.Feb.2011 kl. 19:01

virker for mig.
Har du et ark som hedder Ark2 ?

-------------
VH rassten

Arbejde excel 2010
Privat excel 2010

Besked fra: Allan
Posteringsdato: 19.Feb.2011 kl. 23:17

rassten skrev:

Mit tidligere indlæg var ikke et forsøg på at overtage tråden fra Allan, men blot et forslag.

Det gør absolut intet rassten, det vigtigste er at vi får løst denne udfordring

KIM:

rasstens kode er faktisk temmelig godt lavet, det eneste du mangler at få styr på er arknavnene.

Nu har du tidligere sendt mig en PM med dit ark, så jeg har dine arknavne.

Jeg har rettet lidt i koden, og poster nu rasstens udgave (håber det er OK rassten), med et par rettelser fremhævet med FED:

Sub b_test()

Dim wdApp As Object
Dim wdDoc As Object

Dim objFolders As Object

Dim ArkNavn, RedirArk, DataSti, Filnavn As String

Set objFolders = CreateObject("WScript.Shell").SpecialFolders

        ArkNavn = "Menu" 'Navnet på den fane som skal udskrives
        RedirArk = ActiveSheet.Name 'Navnet på den fane som skal aktiveres efter koden er afviklet
        DataSti = objFolders("mydocuments") & "\MenuPlan\" 'Der hvor filen skal gemmes, husk at afslutte med \
        Filnavn = "Menuplan_" & Sheets(ArkNavn).Range("A1").Value & ".docx"

        'Tjekker om mappen 'DataSti' eksisterer, hvis ikke oprettes den
        If Dir(DataSti, vbDirectory) = "" Then
            MkDir DataSti
        End If

    Application.ScreenUpdating = False

    Set wdApp = GetObject("", "Word.Application")
    Set wdDoc = wdApp.documents.Add

    Worksheets(ArkNavn).Activate 'word vil kun kopiere fra det aktive ark
    ActiveWindow.DisplayGridlines = False
    ' ellers bliver gridlines kopieret over på word

    Range("a1:f25").Copy
    'det kan kun være det kopieret område som overføres til word
    wdApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteText, _
    Placement:=wdInLine, DisplayAsIcon:=False

    'Slette filen hvis den allerede findes
    On Error Resume Next
    Kill DataSti & Filnavn

On Error Resume Next
wdDoc.SaveAs DataSti & Filnavn

wdApp.documents.Close savechanges:=False

On Error GoTo 0

wdApp.Quit

Set wdApp = Nothing
Set wdDoc = Nothing

ActiveWindow.DisplayGridlines = True
Application.CutCopyMode = False

Worksheets(RedirArk).Activate
Application.ScreenUpdating = True
End Sub

//Allan

Besked fra: kbno
Posteringsdato: 20.Feb.2011 kl. 11:17

Jeps så funker det Hug

havde lige hovedet under armen Embarrassed

Takker 10000 for hjælpen - nu låses regnearket - så ikke flere ? i denne omgang Thumbs Up

-------------
Hygge - Kim
Excel 365 DK user

Besked fra: Allan
Posteringsdato: 20.Feb.2011 kl. 11:26

Super Kim, så starter vi da bare en anden tråd næste gang

Jeg vil i hvertfald sige velbekomme for min del af koden, det var faktisk en lærerig tråd hvor resultatet også kan bruges i mange andre sammenhænge.

//Allan

Besked fra: rassten
Posteringsdato: 20.Feb.2011 kl. 16:15

Allan skrev:

Jeg har rettet lidt i koden, og poster nu rasstens udgave (håber det er OK rassten), med et par rettelser fremhævet med FED:

Helt OK med mig, det vigtigste er at den kommer til at virke.

Det har været med meget lærerig tråd for mig.

-------------
VH rassten

Arbejde excel 2010
Privat excel 2010

Print side | Luk vindue