VBA: gem seperat fil uden VBA

Alternativ tilgang: Hvad med bare at lave en ny workbook og så kopiere data over i den?

Ja, det er jo lige det jeg gerne vil - men den eneste måde jeg kender, er hvor man gemmer nuværende excelfil.

Kan du en hurtig kodning til din alternative løsning?

Ville så blive et problem ved meget store datamængder - men den alternative løsning, ville virke lige nu og her :)

(hvis andre har en løsning er de stadig velkommen med input!)

Vender lige tilbage senere i aften...

Hvad med at gemme det som XML-regneark 2003, så kommer dine VBA koder ikke med i den ny fil.
----------------------------------------------
HELP:
Excel-formatering og -funktioner, som ikke overføres til andre filformater:

XML-regneark 2003 Filformatet til dette XML-regneark 2003 (.xml) bevarer ikke følgende funktioner:
**Visual Basic for Application-projekter.
  Revisionspile
  Diagrammer og andre grafikobjekter
  Diagramark, makroark, dialogark
  Brugerdefinerede visninger
  Henvisninger til datakonsolidering
  Tegneobjektlag
  Dispositions- og grupperingsfunktioner
  Regnearkdata beskyttet med adgangskode
  Scenarier
  Brugerdefinerede funktionskategorier.

God ide, synes jeg - hvis du kan bruge denne løsning, vil jeg ikke gøre mere ved den alternative løsning.

Hej igen :)

Desværre så har jeg diagrammer og andet grafisk, som skal med over i den nye fil :(

Så hvis nogen kan give en hurtig metode til at lave et nyt xls dokument uden VBA koden ville jeg være henrykt :)

Nu har jeg lige googlet lidt mere og fandt denne "løsning"

http://www.vbaexpress.com/kb/getarticle.php?kb_id=359

Den fungerer helt efter hensigten!!! MEN når jeg åbner den nye fil siger den:

"the file you are trying to open, is in a different format than specified by the file extension. Verify that the file is not corrupted...."

Kan nogen evt. hjælpe med at undgå denne fejlbesked?

følger blot tråden...

Tror jeg har fundet løsningen nu :)

Det virker i hvert fald her :) Men kan ikke lige overskue og forbedre koden til at blive mindre rodet - måske nogen kan hjælpe her :)

Private Sub cmdka_Click()
Application.DisplayAlerts = False 'don't show alerts when startup
    Dim NewName As String
    Dim nm As Name
    Dim ws As Worksheet
   
    If MsgBox("Copy specific sheets to a new workbook" & vbCr & _
    "New sheets will be pasted as values, named ranges removed" _
    , vbYesNo, "NewCopy") = vbNo Then Exit Sub
   
    With Application
        .ScreenUpdating = False
       
        '      Copy specific sheets
        '      *SET THE SHEET NAMES TO COPY BELOW*
        '      Array("Sheet Name", "Another sheet name", "And Another"))
        '      Sheet names go inside quotes, seperated by commas
        On Error GoTo ErrCatcher
        Sheets(Array("Sheet1")).Copy
        On Error GoTo 0
       
        '      Paste sheets as values
        '      Remove External Links, Hperlinks and hard-code formulas
        '      Make sure A1 is selected on all sheets
        For Each ws In ActiveWorkbook.Worksheets
            ws.Cells.Copy
            ws.[A1].PasteSpecial Paste:=xlValues
            ws.Cells.Hyperlinks.Delete
            Application.CutCopyMode = False
            Cells(1, 1).Select
            ws.Activate
        Next ws
        Cells(1, 1).Select
       
        '      Remove named ranges
        For Each nm In ActiveWorkbook.Names
            nm.Delete
        Next nm
        .ScreenUpdating = True
        End With
            Dim Filnavn As String
  Dim Svar As Integer
 
  Filnavn = "tobias2"
 
  'Spørger om vil gemme med pågældende filnavn
  Svar = MsgBox("Vil du gemme med følgende filnavn" & vbNewLine & Filnavn, vbYesNo)
 
  'Hvis svaret er ja gemmes filen, og data overføres til databasen
  If Svar = 6 Then
 
        'Gemmer filen
        ActiveWorkbook.SaveAs Filename:="\\test\" & Filnavn & ".xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
        Windows("tobias2.xls").Close
        'Application.ThisWorkbook.Close
        MsgBox "filen er gemt i mappen" & vbNewLine & "J:\test"

        End If
       
    Windows("test.xls").Activate
   
    Exit Sub
   
ErrCatcher:
    MsgBox "Specified sheets do not exist within this workbook"



End Sub

Her er den uden promts og hvor den henter filnavnet fra en celle:

Private Sub cmdka_Click()
Application.DisplayAlerts = False 'don't show alerts when startup
   
    Dim nm As Name
    Dim ws As Worksheet
    Dim Filnavn As String

   
    'If MsgBox("Copy specific sheets to a new workbook" & vbCr & _
    '"New sheets will be pasted as values, named ranges removed" _
    ', vbYesNo, "NewCopy") = vbNo Then Exit Sub
   
  With Application
        .ScreenUpdating = False
       
        '      Copy specific sheets
        '      *SET THE SHEET NAMES TO COPY BELOW*
        '      Array("Sheet Name", "Another sheet name", "And Another"))
        '      Sheet names go inside quotes, seperated by commas
        On Error GoTo ErrCatcher
        Sheets(Array("Sheet1")).Copy
        On Error GoTo 0
       
        '      Paste sheets as values
        '      Remove External Links, Hperlinks and hard-code formulas
        '      Make sure A1 is selected on all sheets
        For Each ws In ActiveWorkbook.Worksheets
            ws.Cells.Copy
            ws.[A1].PasteSpecial Paste:=xlValues
            ws.Cells.Hyperlinks.Delete
            Application.CutCopyMode = False
            Cells(1, 1).Select
            ws.Activate
        Next ws
        Cells(1, 1).Select

        '      Remove named ranges
        For Each nm In ActiveWorkbook.Names
            nm.Delete
        Next nm
        .ScreenUpdating = True
        End With

 
  Filnavn = ActiveWorkbook.Sheets("Sheet1").Range("A18").Value
 
        'Gemmer filen
        ActiveWorkbook.SaveAs Filename:="\\test\" & Filnavn & ".xls", FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
        Windows(Filnavn & ".xls").Close

    Windows("test.xls").Activate
    Application.DisplayAlerts = True 'show alerts
    Exit Sub
   
ErrCatcher:
    MsgBox "Specified sheets do not exist within this workbook"

End Sub

hmmm...Den fjerner ikke VBA kode :(

Troede lige jeg var nået målet - dog så fjerner den userforms og makroer :)

Check denne side (specielt "DeleteAllVBACode" kunne være interessant for dig).

Husk at læse instruktionerne i toppen.

Hej Anlu

Hvilken side? Tror der mangler et link :)

Lille detalje ;-)

http://www.cpearson.com/excel/vbe.aspx

Hej Anlu

Jeg fandt aldrig den helt rigtige løsning. Men synes du skal have point for din store hjælp.

Smid besked og du vil få point

ok - hermed et svar. Ærgerligt at du ikke fandt en løsning. Var der et bestemt issue med cpearson's metode?

Det var simpelthen fordi jeg ikke rigtig forstår løsningen. Jeg har ikke kunne få det til at virke. Tror måske jeg havde behov for en konkret løsning i stedet.

Jeg tror du ville være tæt på hvis du i din kode åbnede den kopi du har lavet og så bruger hans kode i "DeleteAllVBACode".

Noget i stil med:

Dim wbKopi as Workbook
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule

Set wbKopi = Workbooks.Open(<sti>)
        
Set VBProj = wbKopi.VBProject
        
For Each VBComp In VBProj.VBComponents
    If VBComp.Type = vbext_ct_Document Then
    Set CodeMod = VBComp.CodeModule        
    With CodeMod
            .DeleteLines 1, .CountOfLines
        End With
    Else
        VBProj.VBComponents.Remove VBComp
    End If
Next VBComp

Men der er nogle sikkerhedsindstillinger der skal sættes for at det kan bruges - se hans indledende tekst.

Jeg vil prøve at gøre det - så må vi se :)

Men du skal have mange mange tak for din hjælp :)