CIO Tech Eksperten IT-JOB IT-Kurser Events Podcast Søg

Log ind eller opret profil

Du kan også logge ind via nedenstående tjenester

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:-)

Synes godt om

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

Synes godt om

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

Synes godt om

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

Synes godt om

Jan Hansen Ekspert

28. januar 2017 - 22:43 #4

Har lige lavet et par små rettelser.

mvh Jan

Synes godt om

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

Synes godt om

Jan Hansen Ekspert

29. januar 2017 - 11:36 #6

Foreslag til 2) tilføje:

& " " & time &

ej testet

mvh Jan

Synes godt om

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

Synes godt om

Jan Hansen Ekspert

29. januar 2017 - 14:07 #8

se onedrive for ny ver.

mvh jan

Synes godt om

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

Synes godt om

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

Synes godt om

Jan Hansen Ekspert

29. januar 2017 - 15:42 #11

Ny Ver. Klar

Jan

Synes godt om

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:-)

Synes godt om

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

Synes godt om

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

Synes godt om

Jan Hansen Ekspert

30. januar 2017 - 20:09 #15

Det var så lidt og ilm

Synes godt om

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.

Følg dette spørgsmål

Opret Preview

Flere spørgsmål fra Excel kategorien

Titel	Indlæg	Oprettet	Seneste aktivitet
Få excel til at indsætte værdi i månedsfelter ud fra start og stop dato Af CBH i Excel	2	08/05/202413:16	10/05/202408:59
Dato opslag udfordring igen igen Af Klaus W i Excel	6	08/05/202410:15	08/05/202416:07
Sumfunktion ud fra dato Af scholes i Excel	3	08/05/202408:34	08/05/202413:29
Vise flere ark fra samme workbook Af Nanarsi i Excel	3	07/05/202410:33	09/05/202412:56
Makro: Hvis fundet flere, så.... Af EveryMA i Excel	1	06/05/202415:28	07/05/202408:09

Se alle spørgsmål i kategorien Opret spørgsmål

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

Alle kategorier på Eksperten

Seneste artiklerRSS

10/05

Guide: Sådan surfer du under hackernes radarer – via en VPN-forbindelse

10/05

Opdater din browser med det samme: Stor sårbarhed rammer Chrome og en række andre browsere

10/05

KL jubler over regeringens indtog i Chromebook-sagen: Vigtig deadline er på plads

10/05

Nørgaard: Ugens lynkursus i ledelse

10/05

CFCS: Cybertruslen mod sundhedsvæsenet bliver værre og værre

10/05

2,7 millioner medlemmer kan ikke få udbetalt tilskud: Nyt it-system lukker Sygeforsikring Danmark helt ned i to uger

10/05

Mistral AI lukkede den største investeringsrunde i Europas historie uden et eneste produkt: Nu er selskabet over 41 milliarder kroner værd

10/05

USA vil blokere for avanceret AI-software til Kina: Der er dog et lille problem

10/05

Microsoft fortsætter offensiven med enorm investering: Pumper 23 milliarder kroner i amerikansk stat

10/05

Streaming: Sidste sæson på vej om oprørshelten Cassian Andor

10/05

Den næste bølge af AI vil se om tre år: Kommer til at handle om hyperautomatisering

Vis flere artikler

IT-JOB

Styrelsen For It og Læring

Erfaren softwareudvikler til Styrelsen for It og Læring – vær med til at skabe forretningskritiske it-systemer til test, prøver og eksamen

ATP

Erfaren konsulent til at drive vores Project Office til næste niveau

Danske Spil A/S

Løsningsarkitekt med analytisk sans og stærke kommunikationsevner

FOA

Forretningskonsulent til IT og digitalisering der gør en forskel

Netcompany A/S

IT Consultant

Vis flere jobs

Seneste spørgsmål Seneste aktivitet

47 min siden	i En Access rapport Af pouls i Access
I går 18:37	windows tablet står på en anden adresse Af jpc1 i Andet software
09/0517:49	iCal-feed og import til google kalender driller Af nemlig i PHP
08/0513:47	Virker vores webshop troværdig? Noget der skal ændres? Af jonaslo98 i Webdesign
08/0513:16	Få excel til at indsætte værdi i månedsfelter ud fra start og stop dato Af CBH i Excel