Bereich als Website speichern

Sub Workbook_BeforeClose(Cancel As Boolean)



       Range("A1:T56").Select

    ActiveWorkbook.Save

    With ActiveWorkbook.PublishObjects( _

       "Aufschreibung_14788") 

        .HtmlType = xlHtmlStatic

        .Filename = _

        "https://sharepoint.com/sites/Ordner/Testdatei.htm" 

        .Publish (False)

        .AutoRepublish = False

     End With



End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Dim publishObject As PublishObject

    Dim speicherPfad As String

    Dim zielArbeitsblatt As Worksheet

    

    ' Arbeitsblatt und Speicherort definieren

    speicherPfad = "https://sharepoint.com/sites/Ordner/Testdatei.htm"

    Set zielArbeitsblatt = ThisWorkbook.Sheets("DeinArbeitsblattName") ' Hier Arbeitsblattnamen anpassen



    ' Fehlerabfangroutine aktivieren

    On Error GoTo Fehlerbehandlung 



    ' Ziel-Arbeitsblatt aktivieren, um den richtigen Bereich zu erfassen

    zielArbeitsblatt.Activate



    ' Vorherige PublishObjects am gleichen Speicherort löschen, falls vorhanden

    For Each publishObject In ActiveWorkbook.PublishObjects

        If publishObject.SourceType = xlSourceRange And publishObject.Filename = speicherPfad Then

            publishObject.Delete ' Vorherige PublishObjects löschen

        End If

    Next publishObject



    ' Neues PublishObject für den korrekten Bereich und das korrekte Arbeitsblatt erstellen

    Set publishObject = ActiveWorkbook.PublishObjects.Add( _

        SourceType:=xlSourceRange, _

        Filename:=speicherPfad, _

        Sheet:=zielArbeitsblatt.Name, _

        Source:="A1:T56", _

        HtmlType:=xlHtmlStatic)



    ' Einstellungen für das PublishObject festlegen

    With publishObject

        .AutoRepublish = False

        .Publish (True) ' Veröffentlichen starten

    End With



    ' Speicherung der Arbeitsmappe

    ActiveWorkbook.Save

    Exit Sub



Fehlerbehandlung:

    MsgBox "Speichern als Website ist fehlgeschlagen. Bitte prüfen Sie die Netzwerkverbindung oder Berechtigungen.", vbExclamation

    Resume Next ' Code fortsetzen, ohne den Benutzer zu blockieren

End Sub