Utskrift med hjälp av makro

[Looxoor]

Denna fråga finns säkert redan besvarad någon gång, sökte men fann inget.

 

Kan man göra ett makro som hämtar ett värde från en specifik cell, väljer en pdfskrivare och använder det kopierade värdet som filnamn, samt sparar i en specifik mapp?

 

Som ytterligare förbättring, kan den stega igenom ett antal identiska blad i samma arbetsbok och utföra samma makro tills alla är utskrivna enligt de premisserna?

 

Jag testade att spela in men efter att den väljer rätt skrivare och trycker på skriv ut-knappen så spelas inte det in något mer till makrot.

 

Antar att det beror på att Excel lämnar över till skrivardrivrutinen sedan och kan ej kommunicera med den?

[Monshi]

Vilken version av Excel?

 

Grundläggade info då det i senare version av Excel finns en inbyggd funktion för att skriva till PDF, i tidigare bör det även gå men då får man använda just en PDF-skrivare.

[Looxoor]

Ja, det borde jag ha tänkt på, 2007.

 

Jag testade nu den inbyggda versionen, och den tar bort mina definierade utskriftsområden efter den har kört sin konvertering...

[Monshi]

Den här kodraden är nog det centrala tips du behöver

Me.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
   	Application.Path &"\PDF_test_vba.pdf", Quality:=xlQualityStandard, _
   	IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
   	False

Som helt enkelt skriver bladet (Me) till en PDF-fil, använde de utskriftsområden som finns.

Att stega genom celler/arbetsböcker är en smal sak i sig.

 

Hur bladen ser ut, om de är lika eller ej, är ej av vikt då utskriftsområdena används.

 

Behöver du hjälp med stegningen?

[Looxoor]

Hej!

 

Får ett felmeddelande: "Ogiltig användning av nyckelordet Me".

Jag satte en knapp på en blad kopplat till makrot.

 

Jag antar att application.path är där office ligger, vad

skriver man för att få fram pathen där det aktuella dokumentet

ligger?

Sedan, hur kan man spara data som är kopierad från en cell till en variabel

att använda istället för där du skriver PDF_test_vba.pdf?

 

Sedan är jag ju novis, så jag hade uppskattat väldigt mycket

om du kunde hjälpa mig med stegningen också...

[Monshi]

Me är en referens till det blad koden är skriven på. Om du klistrat in koden på annan plats måste denna uppdateras.

 

Oops skrev jag Application, jag menade ThisWorkbook.Path.

 

Stega genom celler/blad. Måste nog veta lite mer vad du exakt menar. Ska det i, säg, cell A1 stå filnamn och i B1 stå bladet som ska skrivas ut, på rad två nästa blad eller hur ska koden veta vilket blad som ska skrivas ut, vilket filnamn varje blad ska få?

[Looxoor]

Ok, jag öppnade VBA och skapade en ny modul där jag klistrade in koden mellan Sub test() och End Sub.

 

Det finns 28 blad som kan ha innehåll som skall skrivas ut, namngivna 1-28.

Det finns ett annat blad som heter sammanställning (där jag tänkte ha knappen som aktiverar funktionen) där information från blad 1-28 finns med, men mer specifikt:

de celler i c12:c39 som innehåller data motsvarar de blad i spannet som skall skrivas ut, i a12:a39 står även siffrorna 1-28 för att man skall ha koll på vad som ligger

i vilket blad.

 

På respektive blads cell I10 står filnamnet.

 

Blir det väldigt luddigt beskrivet?

[Monshi]

Okej, bladen heter 1-28, det är de namn de fått.

 

Om bladet står omnämnt inom cell A12:A39 så ska det skrivas ut till PDF med det filnamn som finns i cell I10 på respektive blad.

 

Infoga en knapp, lägg in denna kod på arbetbladets kodblad, inte i en modul, alltså bladet där du har knappen

Sub PDFMaker()
Dim rnSheets As Range
Dim myCell As Range
Dim sNameAdress As String
Dim fName As String

sNameAdress = "I10"
Set rnSheets = Me.Range("A12:A39")

For Each myCell In rnSheets
   	If myCell <> "" Then
       	With Worksheets(myCell.Text)
           	fName = ThisWorkbook.Path & "\" & .Range(sNameAdress)
           	.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
               	fName, Quality:=xlQualityStandard, _
               	IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
               	False
       	End With
   	End If
Next myCell


End Sub

och anropa koden.

Denna stegar igenom cellerna A12:A39, om cell tom hoppar den över denna, annars skrivs angivet blad ut till filnamn som finns i cell I10.

[Looxoor]

Tack för koden, det blev dessvärre en missuppfattning, i a12:a39 står alltid siffrorna 1-28, i c12:c39 är det antingen ifyllt eller ej och det är där urvalet skall göras.

 

Jag försökte på mitt enkla vis modifiera koden, men fick en felkod "Indexet är utanför intervall (Subscript out of range (Error 9))".

 

Såhär försökte jag:

 

Sub PDFMaker()
       Dim rnSheets As Range
       Dim rnSheetName As Range
       Dim myCell As Range
       Dim sNameAdress As String
       Dim fName As String

       sNameAdress = "I10"
       Set rnSheets = Me.Range("c12:c39")

       For Each myCell In rnSheets
       If myCell <> "" Then
               Set rnSheetName = ActiveCell.Offset(0, -2)
               With Worksheets(rnSheetName.Text)
               fName = ThisWorkbook.Path & "\..\skickas\" & .Range(sNameAdress) & ".pdf"
               .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                       fName, Quality:=xlQualityStandard, _
                       IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
                       False
               End With
       End If
       Next myCell


End Sub

[Monshi]

Ah, okej, i A12:A39 finns bladens namn

I C12:C39 finns en markering som visar om bladet ska skrivas ut.

 

Står inget, ska det inte skrivas ut, står det något ska det skrivas ut.

 

Nej nej, ActiveCell är helt fel. Bort bort, den ska du aldrig använda.

Några mindre ändringar i det du skrivit, en felkoll inlagd.

Förklara gärna för mig skillnaden mellan din kod och min, vad har jag gjort?

Sub PDFMaker()
Dim rnSheets As Range
Dim rnSheetName As Range
Dim myCell As Range
Dim sNameAdress As String
Dim fName As String
Dim ws As Worksheet
sNameAdress = "I10"
Set rnSheets = Me.Range("c12:c39")

For Each myCell In rnSheets
   	If myCell <> "" Then
       	Set rnSheetName = myCell.Offset(0, -2)
       	On Error Resume Next
       	Set ws = Worksheets(rnSheetName.Text)
       	On Error GoTo 0
       	If ws Is Nothing Then
           	MsgBox "Kan ej hitta arbetsblad med namn " & rnSheetName, vbExclamation, "Fel!"
       	Else
           	With Worksheets(rnSheetName.Text)
           	fName = ThisWorkbook.Path & "\..\skickas\" & .Range(sNameAdress) & ".pdf"
           	.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                   	fName, Quality:=xlQualityStandard, _
                   	IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
                   	False
           	End With
       	End If
   	End If
Next myCell


End Sub

[Looxoor]

Och nu fungerar allt helt klockrent!

 

Stort tack, du är verkligen en guru!

 

Ja, du har ju lagt till variabeln ws för att förenkla koden vid felsökning (definiera en gång och hänvisa till den senare) däremot inte anropat den i with-satsen, men det är nog bara pga stress, så det har jag ändrat i min nuvarande.

 

Sedan en fundering, är on error resume next pga av det inte finns någon else till första if-satsen och att det därmed blir error när påståendet är falskt?

 

Jag undrar däremot över din goto, är 0 implicit definierad eller finns inte hänvisningen?

 

Sedan då uppenbarligen från activecell till mycell, vilket såhär i efterhand är ganska uppenbart.

 

Återigen, jättestort tack!

[Monshi]

Nästan helt rätt.

 

ja, deklarerat ws och sätter denna, försöker, sätta denna, till önskad referens.

On Error Resume Next

gör att koden hoppar till nästa rad om ett fel uppstår, den struntar i felet.

Dvs om Set-satsen fallerar fortsätter koden men variabeln är satt till Nothing vilket kollas i If-satsen

On Error Goto 0

återställer felhanteraren att stanna vid fel.

 

 

opps, miss av mig ja att inte använda ws i With-satsen, ingen direkt funktionsskillnad men givetvis ska den stå där med.

[Looxoor]

Ok, tror jag är med...

 

Försökte tillämpa denna kunskap för att även ha en knapp på samma

sida som rensar ut innehållet på blad 1-28 enligt ett förutbestämt mönster,

som funkar i dagsläget med en modul som anropas med en knapp per blad.

 

Dessvärre får jag error 400, vilket det inte står något nämnvärt intresant om...

 

Sub RensaAllt()

Dim rnSheets As Range
Dim ws As Worksheet
Dim myCell As Range
Dim rnSheetName As Range

Set rnSheets = Me.Range("a12:a39")

   For Each myCell In rnSheets
   Set rnSheetName = myCell
   On Error Resume Next
   Set ws = Worksheets(rnSheetName.Text)
   On Error GoTo 0
   If ws Is Nothing Then
   MsgBox "Kan ej hitta arbetsblad med namn " & rnSheetName, vbExclamation, "Fel!"
   Else
      With ws
        Range("B3:E3").Value = " ."
        Range("E41").Value = 650
        Range("G5:K5").ClearContents
        Range("F7:H7").ClearContents
        Range("B10:E10").ClearContents
        Range("F10:H10").ClearContents
        Range("I10:K10").ClearContents
        Range("B12:K40").ClearContents
        Range("B3:E3").Select
      End With
      End If
   Next myCell
End Sub

 

Testade först med

for i = 1 to 28

men inte heller det fick jag att fungera, vad gör jag för fel?

[Monshi]

I With satsen missar du att ange att Range-satsen ska referera till ditt With-objekt. Du ordnar detta genom att skriva .Range(...) istället, dvs lägga in en punkt.

 

Utan punkten blir effekten av Range-satsen att, beroende på var den står, att den skriver till det blad koden är skriven till (ekvivalent med Me.Range) eller på aktiva bladet (ActiveSheet.Range)

 

Sedan kan du inte göra en Select-sats på ett blad som är inte aktivt/synligt, bort med den raden.

[Looxoor]

Jag bugar och bockar, alldeles utmärkt!

 

Av ren nyfikenhet: hade det gått lika bra med for i = 1 to 28?

[Monshi]

ja det hade det, lite annan syntax bara.

 

I teorin tror jag att jag läst någonstans att For Each kanske är aningen snabbare än men på en kort kodsnutt som detta märks absolut ingen skillnad.

[Looxoor]

När jag ändå håller på, skulle man kunna skriva ut på en vanlig skrivare samtidigt fast med specifika inställningar från skrivardrivrutinen?

 

Jag testade att bara spela in när jag gjorde det men den fick inte med några inställningar.

 

Jag förstår att detta inte är någon info att gå på, men jag vet inte vad som behövs.

[Monshi]

Då är frågan om vid programmeringstillfället vet vilken skrivare som ska användas eller om vi måste via en dialog till användaren hämta skrivare. Eller för den delen, helt enkelt skriva ut till standardskrivaren.

 

Tror att om du vill styra skrivarespecifika inställningar, då måste vi gå via dialog och det är då upp till användaren att välja dessa.

 

Okej, en sökning på nätet ger träff som denna

http://pubs.logicalexpressions.com/Pub0009/LPMArticle.asp?ID=116

snabb titt ger att om man går via Windows API kan man nå en del av inställningarna

 

Vilka inställningar är det du vill göra?

[Looxoor]

Tja, det är ju acceptabelt att via dialog direkt efter ett tryck på "skriv ut + PDF"-knappen välja inställningar, men bäst vore naturligtvis förinställt vid programmeringen.

 

Vid inspelningen fick jag ut denna snutt, Application.ActivePrinter = "GOTATUNNELN-04 på Ne02:" vilket ju är gott då skrivaren väljs där.

 

Inställningen jag vill göra är att den sätter en häftklammer i vänster hörne.

[Monshi]

Den inställningen kan du sätta i skrivarens drivrutin antar jag, inte i Excels egna utskriftsdialog utan när du trycker upp egenskaper för skrivaren?

 

 

jag tar och sover på saken och återkommer imorgon... tror det kan bli svårt att nå den egenskapen men kanske... ett stort kanske. ... om du klarar dig utan den detaljen automatiskt så är det ganska enkelt att lösa det du önskar.

[Looxoor]

Helt riktigt, varför jag tvekar stort till att det är smidigt att lösa...

Det är en HP Color Laserjet CM6040 MfP.

 

Nej precis, är det väldigt omständligt går det ju bra att, precis vid knapptryckningen få upp den vanliga skrivardialogen med möjlighet att göra inställningar i drivrutinen.

Men om det skall vara värt det skall man ju bara behöva välja en gång, även om alla 28 blad skall skrivas ut...

[Monshi]

jadu, det blir en liten variant av tidigare koden.

Sub PDFMaker2()
   	Dim rnSheets As Range
   	Dim rnSheetName As Range
   	Dim myCell As Range
   	Dim sNameAdress As String
   	Dim fName As String
   	Dim ws As Worksheet
   	sNameAdress = "I10"
   	Set rnSheets = Me.Range("c12:c39")
   	On Error Resume Next
   	'denna rad ger ett fel om skrivaren inte finns, därav inneslutning av felhanterare.
   	'kanske felet bör hanteras?
   	Application.ActivePrinter = "GOTATUNNELN-04 på Ne02:"
   	On Error GoTo 0
   	'tar upp skrivardialog.
   	Application.Dialogs(xlDialogPrinterSetup).Show
   	'samma kod som förut
   	For Each myCell In rnSheets
       	If myCell <> "" Then
           	Set rnSheetName = myCell.Offset(0, -2)
           	On Error Resume Next
           	Set ws = Worksheets(rnSheetName.Text)
           	On Error GoTo 0
           	If ws Is Nothing Then
               	MsgBox "Kan ej hitta arbetsblad med namn " & rnSheetName, vbExclamation, "Fel!"
           	Else
               	With ws
                   	'med en skillnad.
                   	.PrintOut
                   	'alternativt, bara för att vara säker...
                 	'  .PrintOut ActivePrinter:="GOTATUNNELN-04 på Ne02:"
               	End With
           	End If
       	End If
   	Next myCell
End Sub

Att försöka programmeringsmässigt nå att ställa in häftklammern.. ja, för att jag ska göra det får du nog ta och anställa mig på konsultbasis...

Knappast värt det.

Och jag lovar inte att jag lyckas.

[Looxoor]

Den använde inte inställningarna jag gjorde, den bara skrev ut, men dialogrutan var väldigt smidig...

 

Hoppar nog konsultuppdraget denna gången! =)

 

 

Sedan så försökte jag mig på att fortsätta felhanteringen, utifall att man glömmer att fylla i I11 för filnamnet, men jag kom bara såhär långt, efter dialogen så fortsätter den bara.

Det jag skulle vilja är att man får en likadan dialog med ifyllningruta som både skriver det inmatade till I11 och använder datat, jag misslyckas med att hitta något vettigt...

 

Sub PDFMaker()
       Dim rnSheets As Range
       Dim rnSheetName As Range
       Dim myCell As Range
       Dim sNameAdress As String
       Dim fName As String
       Dim ws As Worksheet
       sNameAdress = "I10"
       Set rnSheets = Me.Range("c12:c39")

       For Each myCell In rnSheets
       If myCell <> "" Then
               Set rnSheetName = myCell.Offset(0, -2)
               On Error Resume Next
               Set ws = Worksheets(rnSheetName.Text)
               On Error GoTo 0
               If ws Is Nothing Then
               MsgBox "Kan ej hitta arbetsblad med namn " & rnSheetName, vbExclamation, "Fel!"
               Else
               'With Worksheets(rnSheetName.Text)
               With ws
               If .Range(sNameAdress) = "" Then
               MsgBox "Du måste fylla i cellen för TA-plansnummer i blad " & rnSheetName, vbExclamation, "Fel!"
               Else
               fName = ThisWorkbook.Path & "\skickas\" & .Range(sNameAdress) & ".pdf"
               .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                       fName, Quality:=xlQualityStandard, _
                       IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
                       False


               End If
               End With
               End If
       End If
       Next myCell


End Sub

[Monshi]

Mmh, dialogrutan ger att rätt skrivare används men inställningarna används inte. Ivartfall när jag testar mot en PDF-skrivare. Får klura på det, testa lite.

 

Koden, något i stil med detta?

 With ws
If .Range(sNameAdress) = "" Then
   	Dim answ As String

   	answ = InputBox("Namn saknas för utskrift av blad " & ws.Name & vbNewLine _
    	& "Ange ett nu eller tryck avbryt för att hoppa över", "Namn saknas")
   	If answ <> "" Then
      	.Range(sNameAdress) = answ
   	End If
End If
If .Range(sNameAdress) <> "" Then
   	fName = ThisWorkbook.Path & "\skickas\" & .Range(sNameAdress) & ".pdf"
   	.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
           	fName, Quality:=xlQualityStandard, _
           	IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
           	False
End If
End With

[Looxoor]

Exakt så, konstigt beteende...

 

Den fungerade kanon, tack!