Avatar billede M_M Mester
28. januar 2017 - 17:59 Der er 14 kommentarer og
1 løsning

VBA til at eksportere/gemme ark som seperate filer (kun med værdier og formater)

Hej. Jeg har trevlet webben igennem for at finde fungerende makroer til at gemme alle ark i en fil som separate filer - med kun værdier og formater (dvs. uden formler og eksterne links) - men uden at få nogle af disse makroer til at fungere. Jeg har nu kombineret diverse makroer (taget lidt af det "bedste") og kæmpet for at få det til at fungere ved at lave min egen - men jeg kan ikke få den til at fungere ordentligt.

Makroen skal bruges til hvis man har en indkøbsprisliste (i f.eks. første fane), og så ganger forskellig fortjeneste på forskellige kunder (i de øvrige faner). Her skal kunden så modtage sin egen prisliste - men uden links og formler. Men inkl. den formatering, som man har foretaget (f.eks. udsalgsvarer med gul).

Jeg har arbejdet på en makro med flg. funktion:

- Viser alle ark - dvs. gør også de skjulte synlige (så man ikke glemmer nogle)
- Eksporterer alle ark med kun værdier og formater - bortset fra ark, der har en rød fanefarve (så man derved kan vælge at undlade ark ved at lave fanefarven rød, såsom arket med indkøbspriser)
- Filerne gemmes som xlsx i en brugervalgt mappe.
- Filerne navngives med fanenavn (fra kildefanen) og datoen for kørsel af makroen.

Jeg har lagt min makro og eksempel på xlsx-filen her. Jeg kører både Excel 2010 og 2016.

https://www.dropbox.com/sh/r4bepynbh0ioxdd/AABbKzQ8ZKiOeU2X47tn0tPba?dl=0

Jeg håber, at nogle kan hjælpe:-)

Mvh. Martin

En lille sideinfo; Min kongstanke er senere at lave to valgmuligheder ift. hvad skal kopieres med en case-struktur, da jeg også kan bruge det i andre opgaver, altså
a) En inputbox med "Hvilke ark skal eksporteres? i) Alle ark, i)) Alle synlige ark, iii) Alle synlige ark uden rød fanefarve og
b) En inputbox med "Hvad skal eksporteres? i) Værdier, ii) Værdier og formater, iii) Alt (inkl. formler og links)
Men det kan jeg forsøge mig med senere - kan det andet komme til at virke er jeg meget glad:-)
Avatar billede Jan Hansen Ekspert
28. januar 2017 - 19:43 #1
Tror du kan bruge noget i denne retning:

Option Explicit
Dim wb As Workbook
Dim wbNew As Workbook
Dim ws As Worksheet
Dim wsNew As Worksheet
Dim rCell As Range
Sub Kør()
    Test ("")
End Sub
Sub Test(sPath As String)
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
        Set wb = ThisWorkbook
        If sPath = "" Then sPath = wb.Path & "\"
        For Each ws In wb.Sheets
            If Not ws.Tab.Color = 255 Then
                Set wbNew = Workbooks.Add
                Set wsNew = wbNew.Sheets(1)
                Set rCell = wsNew.Range("A1")
                With wsNew
                    .Name = ws.Name
                End With
                ws.Activate
                ws.Cells.Select
                Selection.Copy
                With rCell
                    .PasteSpecial Paste:=xlPasteAllUsingSourceTheme
                    .PasteSpecial Paste:=xlPasteValues
                End With
                wbNew.SaveAs Filename:=sPath & ws.Name, FileFormat:=51
                wbNew.Close
            End If
            Set wbNew = Nothing
        Next ws
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub


Mvh Jan
Avatar billede M_M Mester
28. januar 2017 - 20:15 #2
Hej Jan. Mange tak for svaret - men jeg får syntax error allerede ved nedenstående?:
  Sub Kør()
     Test ("")
  End Sub
Og næsten hele makroen er med rød skrift. Har du prøvet at køre makroen f.eks. på den fil jeg har lagt ud? Jeg kan umiddelbart heller ikke se muligheden for brugeren for at vælge den mappe hvor filerne skal placeres eller lave filnavn lig arknavn+dato? :-)
Mvh. Martin
Avatar billede Jan Hansen Ekspert
28. januar 2017 - 21:15 #3
Nu ligger dit projekt her:

https://1drv.ms/f/s!AmlqgsyjsAq5gaAx6L5fH1Nc3EIggQ

jeg har de til at virke her. jeg har sat komentarer i vba'en

mvh Jan
Avatar billede Jan Hansen Ekspert
28. januar 2017 - 22:43 #4
Har lige lavet et par små rettelser.

mvh Jan
Avatar billede M_M Mester
29. januar 2017 - 10:29 #5
Hej Jan.

Mange tak, det ser rigtigt godt ud. Jeg markerer det som løsning:-) Må jeg dog spørge om to ting:

1) Når et område er formateret som tabel i de oprindelige faner så fjernes denne tabel-formatering i de kopierede faner. Er det muligt at inkludere tabel-formateringen eller vil det også samtidig indebære kopi af formler og links (som jo ikke ønskes)?

2) Hvis man har en fil åben som svarer til det kommende filnavn kommer naturligt nok en run-time error 1004. Er det muligt f.eks. inden nedenstående at ligge en funktion ind, der looper gennem filerne i mappen og tjekker om alle er lukkede og a) hvis ikke filerne er lukkede så lukker dem hvis der ikke er nogle ændringer siden de sidst blev gemt, og b) hvis filer er åbne og er ændret siden de sidst blev gemt så prompter brugeren for at overskrive eller gemme som ny fil?
wbNew.SaveAs Filename:=sPath & "\" & ws.Name & " " & Date, FileFormat:=51

I hvert fald mange tak for hjælpen:-)

Mvh. Martin
Avatar billede Jan Hansen Ekspert
29. januar 2017 - 11:36 #6
Foreslag til 2) tilføje: 

& " " & time &

ej testet

mvh Jan
Avatar billede M_M Mester
29. januar 2017 - 14:06 #7
Hej Jan.

Tak. Vedr. at beholde formatering inkl. tabel-formatering og også logoer (eget firmalogo på kundernes prislister) har jeg lavet en meget kort makro, der gør det.

Den er implementeret i filen "Testmappe2" på
https://www.dropbox.com/sh/r4bepynbh0ioxdd/AABbKzQ8ZKiOeU2X47tn0tPba?dl=0

Men jeg kan ikke komme så langt som at få den implementeret i din fine kode. Har du mulighed for at assistere hermed? Jeg tror det bare er et par linjer, der skal redigeres/indsættes. Når det er fixet fungerer koden lige som jeg har håbet på:-)

Ideen er, at man først kopierer alt (inkl. formler mv.) fra kilden til destinationsarket, så bagefter kopierer man alt både fra/til destinationsarket men indsætter som værdier. Derved bevares al oprindelig formatering og logoer etc.

Mvh. Martin
Avatar billede Jan Hansen Ekspert
29. januar 2017 - 14:07 #8
se onedrive for ny ver.

mvh jan
Avatar billede M_M Mester
29. januar 2017 - 14:26 #9
Takker. Eneste sidste lille ting er, at logoer ikke kommer med. Det gør de, hvis jeg gør som i den lille makro jeg har skrevet/indspillet, dvs.
i det oprindelige ark vælger Crtl-A, Crtl-C
aktiverer arket hvor det skal indsættes
vælger Crtl-V, Crtl-A og så indsætter som værdier.
Mvh. Martin
Avatar billede Jan Hansen Ekspert
29. januar 2017 - 14:44 #10
Skal logo være løst eller knyttet ti et felt
hvis til felt tror jeg det er lettest

mvh Jan
Avatar billede Jan Hansen Ekspert
29. januar 2017 - 15:42 #11
Ny Ver. Klar

Jan
Avatar billede M_M Mester
29. januar 2017 - 16:56 #12
Fungerer helt perfekt - bortset fra én forhåbentlig lille rettelse, men med stor effekt - i destinationsfilerne er det nu igen formler der står i stedet for værdier:-) Så hvis det kan tilrettes, så fungerer koden til UG:-)
Avatar billede Jan Hansen Ekspert
29. januar 2017 - 21:21 #13
Det er " formater som tabel" der skaber problemer, farver du cellerne på anden måde virker den som ligger nu

hvis du bruger  " formater som tabel"  må der en kvikkere end mig til ;-)

mvh Jan
Avatar billede M_M Mester
30. januar 2017 - 18:48 #14
Hej Jan.
Du skal have mange tak for hjælpen, det er jeg meget glad for:-) Jeg har faktisk fået det til at virke med både tabel-format og uden formler:-) Jeg satte nedenstående ind i din kode næst-sidste version (der gemte tabel-formatet, men også formler), lige før koden " Date = Now". Måske lidt som at gå over åen efter vand, men det virker:-)

                wbNew.Activate
                For Each wsNew In Sheets
                wsNew.Activate
                    Cells.Select
                        Selection.Copy
                        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                            :=False, Transpose:=False
                        Application.CutCopyMode = False
                    Range("A1").Select
                Next wsNew

Igen tak, og god aften.

Mvh. Martin
Avatar billede Jan Hansen Ekspert
30. januar 2017 - 20:09 #15
Det var så lidt og ilm
Avatar billede Ny bruger Nybegynder

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.

Loading billede Opret Preview
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester