Forfatter |
Emne Søg Emne funktioner
|
kbno
Guld bruger
Medlem: 07.Feb.2011
Land: Danmark
Status: Offline
Point: 500
|
Sendt: 17.Feb.2011 kl. 15:38 |
Jeps - der lå fejlen havde lige glemt at den bærbare var reinstalleret og endnu ikke havde fået lagt alting på DOH Endnu engang tak for assistancen
|
Hygge - Kim Excel 365 DK user
|
|
|
|
|
kbno
Guld bruger
Medlem: 07.Feb.2011
Land: Danmark
Status: Offline
Point: 500
|
Sendt: 17.Feb.2011 kl. 18:12 |
Ja så kom der alligevel et spørgsmål eller 2 Kan man gøre ovenstående dropdown menu længere ???? Hendes liste er nemlig LANGGGG og så lige en hurtig - kan man lave en knap til GemsomWord - har selv forsøgt at ændre div. "pdf" til "doc" eller "docx" dog uden det lykkedes
|
Hygge - Kim Excel 365 DK user
|
|
rassten
Guld bruger
Medlem: 26.Okt.2010
Status: Offline
Point: 694
|
Sendt: 17.Feb.2011 kl. 22:20 |
blot et forslag
Sub a_test() Dim wdApp As Object Dim wdDoc As Object Set wdApp = GetObject("", "Word.Application") ' wdApp.Visible = True ' fjern "'" hvis du vil se Word åbne Set wdDoc = wdApp.Documents.Add ActiveWindow.DisplayGridlines = False ' ellers bliver gridlines kopieret over på word Range("a1:f25").Copy wdApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteText, _ Placement:=wdInLine, DisplayAsIcon:=False ' wdApp.Visible = False ' fjern "'" hvis du vil se Word lukke On Error Resume Next ' B1 er en celle med dato, men det kan du gøre som du vil wdApp.activedocument.SaveAs "C:\" & "Menu " & Format(Range("B1").Value, "dd-mm-yy") & ".doc" ActiveWindow.DisplayGridlines = True
Set wdApp = Nothing Set wdDoc = Nothing End Sub
|
|
VH rassten
Arbejde excel 2010 Privat excel 2010
|
|
rassten
Guld bruger
Medlem: 26.Okt.2010
Status: Offline
Point: 694
|
Sendt: 17.Feb.2011 kl. 23:44 |
Jeg vil gerne lave slutningen lidt om, ellers skulle word vist nok stadig være i hukommelsen
On Error Resume Next ' B1 er en celle med dato, men det kan du gøre som du vil wdApp.activedocument.SaveAs "C:\" & "Menu " & Format(Range("B1").Value, "dd-mm-yy") & ".docx" wdApp.documents.Close savechanges:=wddonotsavechanges wdApp.Quit
Set wdApp = Nothing Set wdDoc = Nothing ActiveWindow.DisplayGridlines = True Application.CutCopyMode = False
End Sub
|
|
VH rassten
Arbejde excel 2010 Privat excel 2010
|
|
kbno
Guld bruger
Medlem: 07.Feb.2011
Land: Danmark
Status: Offline
Point: 500
|
Sendt: 18.Feb.2011 kl. 07:09 |
OK det virkede til dels - nu skal filen bare gemme det rigtige ark og det rigtige sted.
Som din kodning er nu, gemmer den i roden af C drev og så gemmer den det ark som er aktivt. De linier jeg skal have implenteret er følgende:
DataSti = objFolders("mydocuments") & "\MenuPlan\" Filnavn = "Menuplan_uge" & Sheets(ArkNavn).Range("A1").Value
|
Hygge - Kim Excel 365 DK user
|
|
rassten
Guld bruger
Medlem: 26.Okt.2010
Status: Offline
Point: 694
|
Sendt: 18.Feb.2011 kl. 22:48 |
Mit tidligere indlæg var ikke et forsøg på at overtage tråden fra Allan, men blot et forslag.
Sub b_test()
Dim wdApp As Object Dim wdDoc As Object 'Fra Allan ' Dim ArkNavn, DataSti, Filnavn As String Dim objFolders As Object Set objFolders = CreateObject("WScript.Shell").SpecialFolders
'Ark2 udskiftes alle steder med det Ark som skal bruges - word vil kun kopiere fra det aktive ark DataSti = objFolders("mydocuments") & "\MenuPlan\" 'Der hvor filen skal gemmes, husk at afslutte med \ Filnavn = "Menuplan_" & Sheets("Ark2").Range("A1").Value & ".docx"
'Tjekker om mappen 'DataSti' eksisterer, hvis ikke oprettes den If Dir(DataSti, vbDirectory) = "" Then MkDir DataSti End If
Application.ScreenUpdating = False Set wdApp = GetObject("", "Word.Application") Set wdDoc = wdApp.documents.Add Worksheets("Ark2").Activate 'word vil kun kopiere fra det aktive ark ActiveWindow.DisplayGridlines = False ' ellers bliver gridlines kopieret over på word Range("a1:f25").Copy 'det kan kun være det kopieret område som overføres til word wdApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteText, _ Placement:=wdInLine, DisplayAsIcon:=False 'Slette filen hvis den allerede findes On Error Resume Next Kill DataSti & Filnavn On Error Resume Next wdDoc.SaveAs DataSti & Filnavn
wdApp.documents.Close savechanges:=False On Error GoTo 0
wdApp.Quit
Set wdApp = Nothing Set wdDoc = Nothing ActiveWindow.DisplayGridlines = True Application.CutCopyMode = False
Worksheets("Ark1").Activate Application.ScreenUpdating = True End Sub
|
|
VH rassten
Arbejde excel 2010 Privat excel 2010
|
|
kbno
Guld bruger
Medlem: 07.Feb.2011
Land: Danmark
Status: Offline
Point: 500
|
Sendt: 19.Feb.2011 kl. 10:26 |
Jeg synes i begge er seje og modtager gerne input fra begge Desværre giver ovenstående denne debug fejl. Filnavn = "Menuplan_" & Sheets("Ark2").Range("A1").Value & ".docx"
|
Hygge - Kim Excel 365 DK user
|
|
rassten
Guld bruger
Medlem: 26.Okt.2010
Status: Offline
Point: 694
|
Sendt: 19.Feb.2011 kl. 19:01 |
virker for mig. Har du et ark som hedder Ark2 ?
|
VH rassten
Arbejde excel 2010 Privat excel 2010
|
|
Allan
Forum Admin
Forum Admin
Medlem: 03.Feb.2010
Land: Danmark
Status: Offline
Point: 10330
|
Sendt: 19.Feb.2011 kl. 23:17 |
rassten skrev:
Mit tidligere indlæg var ikke et forsøg på at overtage tråden fra Allan, men blot et forslag.
|
Det gør absolut intet rassten, det vigtigste er at vi får løst denne udfordring
KIM:
rasstens kode er faktisk temmelig godt lavet, det eneste du mangler at få styr på er arknavnene.
Nu har du tidligere sendt mig en PM med dit ark, så jeg har dine arknavne.
Jeg har rettet lidt i koden, og poster nu rasstens udgave (håber det er OK rassten), med et par rettelser fremhævet med FED:
Sub b_test()
Dim wdApp As Object Dim wdDoc As Object
Dim objFolders As Object
Dim ArkNavn, RedirArk, DataSti, Filnavn As String
Set objFolders = CreateObject("WScript.Shell").SpecialFolders
ArkNavn = "Menu" 'Navnet på den fane som skal udskrives RedirArk = ActiveSheet.Name 'Navnet på den fane som skal aktiveres efter koden er afviklet DataSti = objFolders("mydocuments") & "\MenuPlan\" 'Der hvor filen skal gemmes, husk at afslutte med \ Filnavn = "Menuplan_" & Sheets(ArkNavn).Range("A1").Value & ".docx"
'Tjekker om mappen 'DataSti' eksisterer, hvis ikke oprettes den If Dir(DataSti, vbDirectory) = "" Then MkDir DataSti End If
Application.ScreenUpdating = False
Set wdApp = GetObject("", "Word.Application") Set wdDoc = wdApp.documents.Add
Worksheets(ArkNavn).Activate 'word vil kun kopiere fra det aktive ark ActiveWindow.DisplayGridlines = False ' ellers bliver gridlines kopieret over på word
Range("a1:f25").Copy 'det kan kun være det kopieret område som overføres til word wdApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteText, _ Placement:=wdInLine, DisplayAsIcon:=False
'Slette filen hvis den allerede findes On Error Resume Next Kill DataSti & Filnavn
On Error Resume Next wdDoc.SaveAs DataSti & Filnavn
wdApp.documents.Close savechanges:=False
On Error GoTo 0
wdApp.Quit
Set wdApp = Nothing Set wdDoc = Nothing
ActiveWindow.DisplayGridlines = True Application.CutCopyMode = False
Worksheets(RedirArk).Activate Application.ScreenUpdating = True End Sub
//Allan
|
|
kbno
Guld bruger
Medlem: 07.Feb.2011
Land: Danmark
Status: Offline
Point: 500
|
Sendt: 20.Feb.2011 kl. 11:17 |
Jeps så funker det havde lige hovedet under armen Takker 10000 for hjælpen - nu låses regnearket - så ikke flere ? i denne omgang
|
Hygge - Kim Excel 365 DK user
|
|
Allan
Forum Admin
Forum Admin
Medlem: 03.Feb.2010
Land: Danmark
Status: Offline
Point: 10330
|
Sendt: 20.Feb.2011 kl. 11:26 |
Super Kim, så starter vi da bare en anden tråd næste gang
Jeg vil i hvertfald sige velbekomme for min del af koden, det var faktisk en lærerig tråd hvor resultatet også kan bruges i mange andre sammenhænge.
//Allan
|
|
rassten
Guld bruger
Medlem: 26.Okt.2010
Status: Offline
Point: 694
|
Sendt: 20.Feb.2011 kl. 16:15 |
Allan skrev:
Jeg har rettet lidt i koden, og poster nu rasstens udgave (håber det er OK rassten), med et par rettelser fremhævet med FED: |
Helt OK med mig, det vigtigste er at den kommer til at virke. Det har været med meget lærerig tråd for mig.
|
VH rassten
Arbejde excel 2010 Privat excel 2010
|
|