Forfatter |
Emne Søg Emne funktioner
|
rassten
Guld bruger
Medlem: 26.Okt.2010
Status: Offline
Point: 694
|
Emne: Knap til print 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
|
|
|
|
|
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
|
|
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: 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
|
|
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
|
|
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: 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: 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: 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
|
|
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
|
|
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
|
|
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
|
|
Allan
Forum Admin
Forum Admin
Medlem: 03.Feb.2010
Land: Danmark
Status: Offline
Point: 10330
|
Sendt: 17.Feb.2011 kl. 10:03 |
Problemet er at Excel 2003 ikke har indbygget 'Gem som pdf' //Allan
|
|
kbno
Guld bruger
Medlem: 07.Feb.2011
Land: Danmark
Status: Offline
Point: 500
|
Sendt: 17.Feb.2011 kl. 09:43 |
Hej Alllan
Nu har jeg lige åbnet det på arbejde og så kommer der en debugger fejl. Det er følgende der skulle være problemer med.
'Gemmer det aktive ark som .pdf Sheets(ArkNavn).ExportAsFixedFormat _ Type:=xlTypePDF, _ Filename:=DataSti & Filnavn, _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=False
Eneste forskel siden testen i går aftes er versionen af excel - jeg bruger excel 2010 derhjemme og har både en version 2003 + 2007 på arbejde, og ingen af dem virker.
Hjælpppp
|
Hygge - Kim Excel 365 DK user
|
|
Allan
Forum Admin
Forum Admin
Medlem: 03.Feb.2010
Land: Danmark
Status: Offline
Point: 10330
|
Sendt: 16.Feb.2011 kl. 22:12 |
Velbekomme, dejligt jeg kunne hjælpe dig rassten.
//Allan
|
|
rassten
Guld bruger
Medlem: 26.Okt.2010
Status: Offline
Point: 694
|
Sendt: 16.Feb.2011 kl. 22:11 |
Altså uden range
objFolders("desktop") objFolders("allusersdesktop")
jeg kunne ikke genne fil til desktop, uden at kende den speciel sti på andre computere
|
VH rassten
Arbejde excel 2010 Privat excel 2010
|
|
rassten
Guld bruger
Medlem: 26.Okt.2010
Status: Offline
Point: 694
|
Sendt: 16.Feb.2011 kl. 22:08 |
Jeg siger også tak, fin samling. Specielt Range("A1") = objFolders("desktop") Range("A2") = objFolders("allusersdesktop") var dem som jeg havde brug for!
|
VH rassten
Arbejde excel 2010 Privat excel 2010
|
|
Allan
Forum Admin
Forum Admin
Medlem: 03.Feb.2010
Land: Danmark
Status: Offline
Point: 10330
|
Sendt: 16.Feb.2011 kl. 22:05 |
Velbekomme Kim, tak for tilbagemeldingen.
//Allan
|
|
|
kbno
Guld bruger
Medlem: 07.Feb.2011
Land: Danmark
Status: Offline
Point: 500
|
Sendt: 16.Feb.2011 kl. 21:42 |
Allan skrev:
Hej Kim, Er vi ved at være i mål? //Allan |
Jeps og lidt længere 1000000000000 tak for hjælpen endnu engang
|
Hygge - Kim Excel 365 DK user
|
|
Allan
Forum Admin
Forum Admin
Medlem: 03.Feb.2010
Land: Danmark
Status: Offline
Point: 10330
|
Sendt: 16.Feb.2011 kl. 21:13 |
Du har fuldstændig ret rassten, Sendkeys er noget hø.
Jeg har selv haft en del scheduled jobs i Excel som kørte med SendKeys, pludselig var der en som skrev til mig via MSN messenger..... behøver jeg sige mere...
Jeg har en lille samling som jeg naturligvis gerne deler, jeg ved ikke om du kan bruge den, men jeg synes de er guld værd
Sub SpecialMappeNavne() Dim objFolders As Object Set objFolders = CreateObject("WScript.Shell").SpecialFolders
Range("A1") = objFolders("desktop") Range("A2") = objFolders("allusersdesktop")
Range("A3") = objFolders("favorites") Range("A4") = objFolders("mydocuments")
Range("A5") = objFolders("sendto") Range("A6") = objFolders("Recent")
Range("A7") = objFolders("startmenu") Range("A8") = objFolders("allusersstartmenu")
Range("A9") = objFolders("Startup") Range("A10") = objFolders("AllUsersStartup")
Range("A11") = objFolders("Templates") Range("A12") = objFolders("Fonts")
Range("A13") = objFolders("Programs") Range("A14") = objFolders("AllUsersPrograms")
Range("A15") = objFolders("NetHood") Range("A16") = objFolders("PrintHood")
End Sub
|
|