Altijd op bureaublad opslaan bij verschillende gebruikers

[donndz]

Goedemorgen,

Ik wil via een macro een excelbestand altijd laten opslaan op het bureaublad.
Ik heb hiervoor het volgende gebakken en werkt goed.

With ActiveWorkbook.PublishObjects.Add(xlSourcePrintArea, _
        "C:\user\1263465\documents&settings\bureaublad\Voorgangsschema.htm", "Voortgangsschema", "", xlHtmlStatic, _
        "Voortgangschema_2012", "")
        .Publish (False)
        .AutoRepublish = False

Nu wil ik alleen dat verschillende gebruikers op deze wijze de .htm kan opslaan. Dit betekend dat het padnaam bij iedereen anders kan zijn.

Hoe los ik dit op zodat de .html altijd en bij iedereen op het bureaublad wordt opgeslagen.

Alvast dank

 

[Niels28]

Dit stukje gebruik ik en het werkt zeker voor windowsXP & windows7

 Set objWSH = CreateObject("WScript.Shell")
strPath = objWSH.SpecialFolders("Desktop") & "\" &

Niels

 

[Warme bakkertje]

Public Function DesktopAddress() As String
    DesktopAddress = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator
End Function

Sub tst()
    dAddress = DesktopAddress
    With ActiveWorkbook.PublishObjects.Add(xlSourcePrintArea, _
        dAddress, "Voortgangsschema", "", xlHtmlStatic, _
        "Voortgangschema_2012", "")
        .Publish (False)
        .AutoRepublish = False
    End With
End Sub

 

[donndz]

Oke, dat heeft me verder geholpen, alvast dank, maar..
Ik heb de code aangepast naar onderstaande (bepaalde naamstellingen zijn veranderd)

Public Function DesktopAddress() As String
    DesktopAddress = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator
End Function
Sub Print_wedstrijdschema()
Sheets("wedstrijdschema").Select
ActiveSheet.AutoFilterMode = False
Range("B4:N1000").AutoFilter Field:=1, Criteria1:="<>"
With ActiveSheet.PageSetup
       .PrintArea = "$B$1:$N$410"
End With
With dAddress = DesktopAddress
End With
    dAddress = DesktopAddress
With ActiveWorkbook.PublishObjects.Add(xlSourcePrintArea, _
        dAddress, "voortgangsschema", "", xlHtmlStatic, _
        "D&B_2012", "")
        .Publish (False)
        .AutoRepublish = False
ActiveSheet.AutoFilterMode = False
Sheets("Besturingspanel").Select
End With
End Sub

maar zowel deze als de code van WarmBakkertje geeft een foutmelding op:

        .Publish (False)

 

[Warme bakkertje]

Gebruik deze lijn eens

dAddress = DesktopAddress & "voortgangschema.htm"

Deze mag weg

With dAddress = DesktopAddress
End With

 

[donndz]

Geweldig, bedankt!

Hij werkt goed, bedankt!

Public Function DesktopAddress() As String
    DesktopAddress = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator
End Function
Sub Print_wedstrijdschema()
Sheets("wedstrijdschema").Select
ActiveSheet.AutoFilterMode = False
Range("B4:N1000").AutoFilter Field:=1, Criteria1:="<>"
With ActiveSheet.PageSetup
       .PrintArea = "$B$1:$N$410"
End With
dAddress = DesktopAddress & "voortgangschema.htm"
With ActiveWorkbook.PublishObjects.Add(xlSourcePrintArea, _
        dAddress, "voortgangsschema", "", xlHtmlStatic, _
        "D&B_2012", "")
        .Publish (False)
        .AutoRepublish = False
ActiveSheet.AutoFilterMode = False
Sheets("Besturingspanel").Select
End With
End Sub