Just nu i M3-nätverket
Gå till innehåll

Spara specifikt blad både som PDF och ny excelbok.


the_bear_58

Rekommendera Poster

the_bear_58

Hej.

Har lite problem med ett makro, det stannar vid "Sheets("Med datum")………..och visar felkod "Dokumentet sparades inte".... (Se bild).

 

 

Har hittat makrot men har inte lyckats modifiera det rätt.

Jag är ingen expert på makro så jag är tacksam för all hjälp.

 

En liten förklaring till vad jag vill att makrot ska göra:

 

Skriva ut ett specifikt blad.

Spara ett specifikt blad till PDF, med namn enligt cell H2 och B3-E3. (Det finns flera blad i samma excelbok).

Spara samma blad till en egen excelbok med samma namn som PDF, utan att makro följer med.

Öka värdet i cell H2 med +1.

Radera värde i ett antal celler.

Spara den öppna excelboken under sitt befintliga namn.

Stänga excelboken.

 

Sub Utskrift()
 ' Print sheet
 Sheets("Med datum").Select
 ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
 IgnorePrintAreas:=False
 Dim NewFN As Variant
 ' Create the PDF
 NewFN = "C:\2018\Invoice" & Range("H2,B3:E3").Value & ".pdf"
 Sheets("Med datum").ExportAsFixedFormat Type:=xlTypePDF, Filename:=NewFN, _
 Quality:=xlQualityStandard, IncludeDocProperties:=True, _
 IgnorePrintAreas:=False, OpenAfterPublish:=False
 ' Save the Excel Sheet
 Sheets("Med datum").Copy
 NewFN = "C:\2018\Invoice" & Range("H2,B3:E3").Value & ".xlsx"
 ActiveWorkbook.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbook
 ' Increment the invoice number
 Range("H2").Value = Range("H2").Value + 1
 ' Clear out the invoice fields
 Range("B3:E3").ClearContents
 Range("G3:H3").ClearContents
 Range("B4:H4").ClearContents
 Range("C5: D5").ClearContents
 Range("F5:H5").ClearContents
 Range("A6:H23").ClearContents
 Range("C25: D25").ClearContents
 Range("C26: D26").ClearContents
 ActiveWorkbook.Save
 ActiveWorkbook.Close
 End Sub

 

 

Tack på förhand

Nisse

VBA felkod.jpg

Länk till kommentar
Dela på andra webbplatser

Några små saker.

1: Select-satser uppmuntras inte, bättre att, oftast, använda with

With Worksheets("Blad1")

   .Range("A1").Value = "hello"

End With

eller än hellre

With Blad1

  'som ovan

End With

 

2: Skapa egna sub-funktioner för saker som inte är funktionens huvuduppgift men kan gå fel. Som att skapa filnamnen, rensa celler. Skapa exempelvis en funktion som heter getFileName som tar datacellerna som indata. Verifiera att denna blir rätt för sig.

 

Jag tror felet ligger i Range("H2,B3:E3").Value som jag inte  tror ger det resultat du förväntar dig. Om du har flera celler med filnamn i måste du stega igenom dessa och spara fil en gång för varje namn. Eller om filnamnet är uppdelat i cellerna måste du sätta ihop dem.

 

Som sagt, dela upp hela funktionen i mindre funktioner så får du nog ihop det.

Länk till kommentar
Dela på andra webbplatser

the_bear_58

Tack för ditt svar Monshi.

 

Jag förstår inte riktigt vad du menar. Som jag nämnde har jag hittat makrot och trodde i min enfald att jag skulle kunna modifiera det, men mina kunskaper räcker inte.

 

Länk till kommentar
Dela på andra webbplatser

Sub Utskrift()
    ' Print sheet
    Dim wb As Workbook
    Dim NewFN As String
    With Blad1
    'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
    'IgnorePrintAreas:=False
    
    ' Create the PDF
        NewFN = PathBuilder(.Range("A1"), "pdf")
        .ExportAsFixedFormat Type:=xlTypePDF, fileName:=NewFN
         ', _
         '   Quality:=xlQualityStandard, IncludeDocProperties:=True, _
         '   IgnorePrintAreas:=False, OpenAfterPublish:=False
        ' Save the Excel Sheet
        .Copy
        Set wb = ActiveWorkbook ' nya boken
        NewFN = PathBuilder(.Range("A1"), "xlsx")
        Application.DisplayAlerts = False
        wb.CheckCompatibility = False
        wb.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbook
        Application.DisplayAlerts = True
    End With
    ' Increment the invoice number
    With wb.Worksheets(1)
      .Range("H2").Value = .Range("H2").Value + 1
    ' Clear out the invoice fields
       
      .Range("B3:E3").ClearContents
      .Range("G3:H3").ClearContents
      .Range("B4:H4").ClearContents
      .Range("C5:D5").ClearContents
      .Range("F5:H5").ClearContents
      .Range("A6:H23").ClearContents
      .Range("C25: D25").ClearContents
      .Range("C26: D26").ClearContents
      wb.Close True
    End With
 End Sub

Function PathBuilder(rnSource As Range, suffix As String) As String
    Dim basePath As String
    basePath = "" '"C:\2018\Invoice\"
    PathBuilder = basePath + rnSource.Value + "." + suffix
End Function

Detta kan du nog bygga vidare på.

 

Länk till kommentar
Dela på andra webbplatser

the_bear_58

Något verkar fel. Makrot stannar vid    .ExportAsFixedFormat Type:=xlTypePDF, fileName:=NewFN

 

Med felmeddelande. 671176853_VBAfelkod_2.thumb.jpg.2ef5349a7d509883615b8fd02afc6dbe.jpg

 

Jag ser att du ändrat värdet för filnamn till från H2,B3:E3 till A1. Varför?

Länk till kommentar
Dela på andra webbplatser

Det har nog med filnamnet att göra, där får du anpassa. Har en statisk text i cell A1 och kommenterat bort din sökväg som du får anpassa.

Behöver du text från flera celler?

 

Function PathBuilder(rnSource1 As Range,rnSource2 As Range , suffix As String) As String
    Dim basePath As String 
    basePath = "C:\2018\Invoice\"
    PathBuilder = basePath + rnSourcee.Value +  rnSource2.value + "." + suffix
End Function
Länk till kommentar
Dela på andra webbplatser

the_bear_58

Får en känsla av att detta projekt är en bra bit över min nivå. Som jag nämnde tidigare, jag hittade makrot och trodde att jag skulle kunna modifiera det.

Jag är tacksam för den hjälp du har gett mig, men det känns lite som att vi slösar tid på ett upphittat makro.

 

Har du lust att hjälpa mig att skriva ett makro som gör det jag vill?

 

 

Länk till kommentar
Dela på andra webbplatser

osäker på hur mycket det är som fattas i det ovan, tycker att du har en grund att stå på så vet inte exakt vad du vill att jag ska göra.

 

vad är det för värden du har i H2 och B2-B3?

Ska dessa värden sättas ihop för att blir filnamnet?

Länk till kommentar
Dela på andra webbplatser

the_bear_58

H2 är ett siffervärde typ "218001".

B3 är ett namn typ "Nisse Tudare".

Jag vill att dessa sätts ihop till ett filnamn typ "21801 Nisse Tudare".

 

Hela poängen med makrot är följande:

Skriva ut ett specifikt blad.

Spara ett specifikt blad till PDF, med namn enligt cell H2 och B3. (Det finns flera blad i samma excelbok).

Spara samma blad till en egen excelbok (xls) med namn enligt cell H2 och B3.

Öka värdet i cell H2 med +1.

Radera värde i ett antal celler.

Spara den öppna excelboken under sitt befintliga namn.

Stänga excelboken.

 

 

Länk till kommentar
Dela på andra webbplatser

Där vi ju nära. Bara att den uppdaterade koden jag gav dig och lite anpassning av resten av koden:

Sub Utskrift()
    ' Print sheet
    Dim wb As Workbook
    Dim NewFN As String
    With Blad1
    'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
    'IgnorePrintAreas:=False
    
    ' Create the PDF
        NewFN = PathBuilder(.Range("H23"), .Range("b23"), "pdf")
        .ExportAsFixedFormat Type:=xlTypePDF, fileName:=NewFN
         ', _
         '   Quality:=xlQualityStandard, IncludeDocProperties:=True, _
         '   IgnorePrintAreas:=False, OpenAfterPublish:=False
        ' Save the Excel Sheet
        .Copy
        Set wb = ActiveWorkbook ' nya boken
        NewFN = PathBuilder(.Range("H23"), .Range("b23"), "xlsx")
        Application.DisplayAlerts = False
        wb.CheckCompatibility = False
        wb.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbook
        Application.DisplayAlerts = True
    End With
    ' Increment the invoice number
    With wb.Worksheets(1)
      .Range("H23").Value = .Range("H23").Value + 1
    ' Clear out the invoice fields
       
      .Range("B3:E3").ClearContents
      .Range("G3:H3").ClearContents
      .Range("B4:H4").ClearContents
      .Range("C5:D5").ClearContents
      .Range("F5:H5").ClearContents
      .Range("A6:H23").ClearContents
      .Range("C25: D25").ClearContents
      .Range("C26: D26").ClearContents
      wb.Close True
    End With
 End Sub

Function PathBuilder(rnSource1 As Range, rnSource2 As Range, suffix As String) As String
    Dim basePath As String
    basePath = "C:\2018\Invoice\"
    PathBuilder = basePath + rnSource1.Value + rnSource2.Value + "." + suffix
End Function

Du kan med fördel namnge området du vill radera och byta ut alla raderna med ClearContents till

.Range("rnToDelete").ClearContets

 

Länk till kommentar
Dela på andra webbplatser

the_bear_58

Har ändrat några cellreferenser för att det skall passa min excel bok.

Körde makro och fick följande fel:

1759334822_VBAfelkod_4.jpg.0cf6363b06c3339b1f4a366e50dff8b1.jpg

 

På raden     PathBuilder = basePath + rnSource1.Value + rnSource2.Value + "." + suffix

 

Länk till kommentar
Dela på andra webbplatser

Function PathBuilder(rnSource1 As Range, rnSource2 As Range, suffix As String) As String
    Dim basePath As String
    basePath = "C:\2018\Invoice\"
  debug.print "Värde 1 " & rnSource1.Value
  debug.print "Värde 2 " & rnSource2.Value
    PathBuilder = basePath & rnSource1.Value & rnSource2.Value & "." & suffix
End Function

Då gissar jag på att det något fel på dina värden i cellerna. Och då blir det svårt att säga något.

men kan testa byta + till & vilket ju nog är med korrekt i VBA. Kan bli så när man blandar programmeringsspråk i huvudet.

Debug-texten skrivs i Direktfönstret.
Sätt breakpoints, stega genom koden, kontrollera värdena. Ett värde är orsaken till felet.

 

Länk till kommentar
Dela på andra webbplatser

the_bear_58

Nu börjar det hända saker. Makrot sparar både PDF och xlsx filer med rätt namn på rätt plats.

Detta är jättebra.

Nu dyker det upp nya problem. Makrot sparar den aktiva fliken, detta är fel, makrot skall spara en annan flik med ett namn typ "Med datum". (Det kommer att finnas fler flikar med andra namn som skall hanteras på samma sätt).

Om jag stegar mig igenom makrot så fungerar allt perfekt fram till rad:

Set wb = ActiveWorkbook ' nya boken

Då öppnar makrot en ny excelbok.

Vid rad:

Application.DisplayAlerts = True

Växlar makrot till den nya excelboken och i denna sker resten av makrot dvs alla raderingar och uppdatering av cell J2.

(Makrot har sparat PDF och excel rätt innan allt detta sker).

Original boken är oförändrad och förblir öppen.

Vid rad:

End With

Stänger makrot den nya och den gamla är oförändrad.

 

Se bifogad fil.

Faktura TEST.zip

Länk till kommentar
Dela på andra webbplatser

Ah, en liten miss av mig. Använder mig av VBA-namnet Blad1. Att ändra detta är enkelt, ändra bara rad 6 till

 With Worksheets("Med Datum")

Om flera blad ska skrivas ut på liknande vis, gör så att utskrift tar bladet som argument.

 

jag brukar säga att en god modell för VBA-kodning är att göra så lite som möjligt i koden. Dvs att man förbereder sidorna  med de fält som behövs och koden går inte in på sidan för att ändra något.
 

Hoppas du lär dig lite på detta äventyr. VBA är inte speciellt svårt att förstå.

 

 

 

Länk till kommentar
Dela på andra webbplatser

the_bear_58

Jodå jag lär mig lite varje gång.

Jag ändrade rad 6, det skapade ett nytt problem.

 

Nu stannar makrot på raden:

.Range("B4:H4").ClearContents

 

Jag tror jag vet varför men vet inte hur jag ska lösa det.

 

Jag tror att makrot försöker radera celler i den nya excel boken.

Detta är fel, alla raderingar skall göras i flik "Reg_utskrift"

Även uppdatering av cell J2 skall göras där.

De andra flikarna skall bara skrivas ut och sparas beroende på vilket makro man kör.

 

Alla flikarna hämtar sina värde från "Reg_utskrift" 

"Reg_utskrift" är så att säga en registrerings flik där alla värde ska knappas in för att sedan skrivas ut som olika varianter av faktura.

De övriga flikarna har alla celler utom J2, låsta för redigering.

 

Jag har kanske varit otydlig om funktionen i excel boken, det ber jag om ursäkt för.

Hoppas du nu förstår bättre vad jag är ute efter.

 

Länk till kommentar
Dela på andra webbplatser

Ah, raderingarna ska ske i origanalboken? Ok.

Stryk End With på rad 23 och With Wb.Worksheets(1) på rad 25

With deklarerar att alla referenser inom With - End With som börjar med . sker på det (objekt) som With har som argument.

Och som sagt tidigare, namnge området du vill radera så kan det räcka med en sats för att ta bort allt.

 

Länk till kommentar
Dela på andra webbplatser

Arkiverat

Det här ämnet är nu arkiverat och är stängt för ytterligare svar.

×
×
  • Skapa nytt...