Prüfung der Dateiversion (als Zellwert)

[Suprasod]

Hallo liebes Forum,

ich habe ein kleines Formular über Excel erstellt, welches von vielen Kollegen in meiner Firma genutzt wird (wir nutzen übrigens MS Office 365 Enterprise). Da sich so ein Formular aber gern mal verändert und gleichzeitig auch viele der Nutzer die Datei Lokal ablegen anstatt die Datei immer aus dem SharePoint Ordner zu öffnen, kommt es natürlich oft vor, dass noch ältere Versionen im Umlauf sind. Meine Idee war jetzt, dass ich mir eine Excel Datei in einen offenen SharePoint Ordner lege und dort beispielsweise in Zelle A1 eine 1 schreibe (stellvertretend für Version 1). Beim Öffnen des Formulars soll ein Makro dann in genau die Zelle schauen um die eigene Version mit dem dortigen Wert abzugleichen. 
Wenn gleich, dann passiert nix, aber wenn die Version des Formulars kleiner ist, dann soll der gesamte Inhalt des Formulars gelöscht und ein Link zur neuen Datei in A1 eingefügt werden.
 
Was auch immer passieren soll ist eigentlich egal, denn ich bekomme es nicht hin, dass eine Lokale Datei eine Exceldatei auf einem SharePoint anspricht um einen Wert abzufragen. Wenn ich 2 Tabellen nebeneinander öffne, kann man ja einfach in die andere Tabelle klicken um eine Verknüpfung herzustellen. Ein Klick in den Browser wird natürlich ignoriert. Vielleicht kann ich auch eine viel simplere Abfrage starten, aber dazu fehlt mir aktuell die Idee (evtl. den eigentlichen Link zum Formular im SharePoint, da sich dieser auch ändert wenn ich die Version im Dateinamen erwähne). 
In jedem Fall muss ich irgendwo im Netz oder auf einem SharePoint einen Hinweis hinterlassen, welcher dann vom Makro geprüft wird. Sobald ich eine neue Version zur Verfügung stelle, ändere ich den Hinweis entsprechend.

Hat von euch schon mal jemand etwas ähnliches probiert oder umgesetzt? Vielleicht denke ich auch viel zu kompliziert.
Jedenfalls wäre ich über Anregungen oder Beispiele sehr dankbar.

[snb]

Das klingt als ob ein AddIn geeignet wäre.

[Suprasod]

Was das angeht, sind mir leider die Hände gebunden. Sowas müsste man ja auf allen Rechnern ausrollen und dazu fehlen mir definitiv die Berechtigungen.

[Suprasod]

Ich habe nun eine Verknüpfung hinbekommen. Was für ein Krampf...

Hier ein Beispiel

Code:

='https://companyxy.sharepoint.com/:x:/r/teams/P0014308/Formulare/[Check.xlsx]Tabelle1'!A1

Dazu muss man auf dem SharePoint den Link der Exceltabelle kopieren. Also direkt über den Menüpunkt "Link kopieren". Bis zur Dateiendung kann alles gelöscht werden, was in meinem Beispiel .xlsx darstellt. Den Namen der Datei in Eckige Klammern setzen und dahinter Blatt und Zelle angeben. Die Adresse muss hinter dem = mit einem Hochkomma begonnen werden und wird direkt hinter dem Namen des Tabellenblatts mit einem Hochkomma beendet.
Dahinter kommt nur noch ein Ausrufezeichen und die zu prüfende Zelle. 

Wichtig ist, dass der Zugriff zu dem SharePoint gewährleistet ist. In meinem Fall habe ich die einzelne Datei so freigegeben, dass alle Mitarbeiter des Unternehmens eine Leseberechtigung haben.

[Suprasod]

dim SP as string
SP = SharePoint

Ich habe mein Formular auf einen sehr akzeptablen Zustand gebracht. 
In der Theorie geht alles und in der "geschützten Praxis" auch. ABER! 
Das die Datei von einigen Kollegen lokal abgespeichert wird, habe ich bereits erwähnt. Wenn jetzt noch jemand auf die Idee kommt die Datei umzubenennen, dann wars das mit dem Makro.
Die Oben erwähnte Formel für die Abfrage vom SP ist leider sehr träge, weshalb ich einen anderen Weg gewählt habe. 
Ich öffne per Makro die Exceltabelle direkt vom SP, kopiere mir 2 Zellen und füge diese in ein verstecktes 2. Tabellenblatt ein, damit ich mit den Werten arbeiten kann.
Anschließend wird die Tabelle von SP wieder ohne zu speichern geschlossen und das Makro widmet sich dann der Prüfung.

Leider komme ich nicht mehr zur Prüfung. An der Stelle wo ich zurück in meine Tabelle möchte, habe ich im Code den Namen der Datei verwendet. Ändert man den Namen, dann kann VBA hier natürlich nichts mehr ansprechen.
Also hab ich mir gedacht, dass ich direkt beim Öffnen der Tabelle erstmal den Namen ermittle und in mein verstecktes Hilfsblatt schreibe. Diesen Zellwert nutze ich dann als den Namen der Mappe. Im kleinen Test klappt das. In meinem großen Aufbau nicht. So langsam werde ich Wahnsinnig. Ich teile mal den Code. Vorweg sei gesagt, ich bin maximal ein interessierter Nutzer. Das ist alles zusammengestümpert aus dem Netz oder mit Hilfe des Makrorekorders aufgezeichnet. Ein bisschen was mach ich auch selbst. Vermutlich komplett überfüllt, aber wie gesagt, für meine Zwecke langt es  .

Code in der Mappe

Code:

Option Explicit                            

Private Sub Workbook_Open()
Dateiname
PersDatenEinfuegen
VersionCheck
VersionAbgleich
End Sub

Code in der Tabelle1

Code:

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
If Not Intersect(Target, Range("D8:D21")) Is Nothing Then
  Target = IIf(Target = "X", "", "X")
  Cancel = True
End If
End Sub

Und nun versuche ich mal der Reihe nach die kleinen Programmbausteine aufzulisten....

Code:

Sub Dateiname()

Worksheets("Tabelle2").Range("H1").FormulaLocal = ActiveWorkbook.Name

End Sub

Code:

Option Explicit

Public Sub PersDatenEinfuegen()

Dim oADInfo As Object
Dim sUserName As String
Dim oUser As Object
Dim sMailAdd As String
Dim sName As String
Dim sDepartment As String
Dim sMobile As String
Dim sVName As String

Set oADInfo = CreateObject("ADSystemInfo")
sUserName = oADInfo.UserName
Set oUser = GetObject("LDAP://" & sUserName)

sMailAdd = oUser.mail
sName = oUser.givenName
sVName = oUser.sn
sDepartment = oUser.department
sMobile = oUser.mobile

Worksheets("Tabelle1").Range("P8").FormulaLocal = sVName & ", " & sName
Worksheets("Tabelle1").Range("P10").FormulaLocal = sDepartment
Worksheets("Tabelle1").Range("P12").FormulaLocal = sMobile
Worksheets("Tabelle1").Range("P14").FormulaLocal = sMailAdd

Set oUser = Nothing
Set oADInfo = Nothing

End Sub

Code:

Sub VersionCheck()

Application.ScreenUpdating = False
Schutz_aus
Sheets("Tabelle2").Visible = True

CheckOeffnen
CheckDatenKopieren
CheckSchliessen

Sheets("Tabelle2").Visible = False
Schutz_an
Application.ScreenUpdating = True

End Sub

Code:

Sub CheckOeffnen()

Dim URL As String

URL = "https://companyxy.sharepoint.com/:x:/r/teams/P0014308/Arbeitszeit%20Check/Check.xlsx"
URLDecoded = URLDecode(URL)
Set WB = Workbooks.Open(URLDecoded)

End Sub

Code:

Sub CheckDatenKopieren()

Application.ScreenUpdating = False
Schutz_aus
Sheets("Tabelle2").Visible = True
    Windows("Check.xlsx").Activate
    Sheets("Tabelle1").Select
    Range("A1:D1").Select
    Selection.Copy
    Windows(Worksheets("Tabelle2").Range("H1").Value).Activate
   
    Sheets("Tabelle2").Select
    Range("A14").Select
    ActiveSheet.Paste
    Sheets("Tabelle1").Select
    Sheets("Tabelle2").Visible = False
 
    Schutz_an
    Application.ScreenUpdating = True
   
End Sub

Code:

Sub CheckSchliessen()

Workbooks("Check.xlsx").Close savechanges:=False

End Sub

Code:

Sub VersionAbgleich()

Worksheets("Tabelle1").Unprotect "********"
Schutz_aus
'Tabelle 2 = Tabelle 3'
If Tabelle1.Range("S63").Value = Tabelle3.Range("A14").Value Then
Else
MsgBox ("Bitte die aktuellste Version des Antrags nutzen. Ein entsprechender Link wird im Dokumentenkopf angezeigt.")
Application.ScreenUpdating = False
ButtonsEntfernen
neueVersion
End If
Schutz_an
Worksheets("Tabelle1").Protect "********"
Application.ScreenUpdating = True
End Sub

Code:

Sub ButtonsEntfernen()

    ActiveSheet.Shapes.Range(Array("Rectangle 11", "Rectangle 12", "Rectangle 13" _
        , "Rectangle 14")).Select
    Selection.Delete
   
End Sub

Code:

Sub neueVersion()
Worksheets("Tabelle1").Range("B2").Value = Worksheets("Tabelle2").Range("B14").Value
Range("B2").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        Worksheets("Tabelle2").Range("B14").Value _
        , TextToDisplay:= _
        Worksheets("Tabelle2").Range("B14").Value
    ActiveSheet.Shapes.Range(Array("Group 21")).Select
    Selection.Delete
    Range("B2").Select
    Range("B2:U2").Select
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    With Selection.Font
        .Name = "Calibri"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -16776961
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Selection.Font.Size = 20
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.Font.Underline = xlUnderlineStyleSingle
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
End Sub

Code:

Sub Schutz_aus()

    ActiveWorkbook.Unprotect "********"
 
End Sub

Sub Schutz_an()

    ThisWorkbook.Protect Password:="********", Structure:=True

End Sub

Laut Debugging beginnt das Problem im Programm "CheckDatenKopieren" bei Sheets("Tabelle2").Visible = True. Also in der 3. Zeile.

[Suprasod]

So... 
auch das Problem konnte ich beheben. Immer wieder schön wenn man auch ohne Hilfe plötzlich weiter kommt.

In 2 Programmen habe ich was verändert. Ich bin immer davon ausgegangen, dass ein Makro sich immer an den Daten der Mappe bedient, in der es geschrieben steht. Außer man spricht halt eine andere Mappe direkt an. Aber in dem Moment wo ich eine andere Mappe auf mache und den Dateinamen der ursprünglichen Mappe an einen Zellwert Koppel, schaut VBA zwar in die entsprechende Zelle, aber leider in der falschen Mappe. Ich musste also auch der kurz geöffneten Mappe beibringen wie die andere Datei heißt.
Die grünen Parts habe ich ergänzt und eine Zeile habe ich gestrichen, weil das bereits an anderer Stelle erledigt wird.

Sub CheckOeffnen()

Dim URL As String

Tabelle3.Range("H1").copy
URL = "https://companyxy.sharepoint.com/:x:/r/teams/P0014308/Arbeitszeit%20Check/Check.xlsx"
URLDecoded = URLDecode(URL)
Set WB = Workbooks.Open(URLDecoded)

End Sub

Sub CheckDatenKopieren()

Application.ScreenUpdating = False
Windows("Check.xlsx").Activate
    Range("A2").Select
    ActiveSheet.Paste
    Windows(Worksheets("Tabelle1").Range("A2").Value).Activate
Schutz_aus
Sheets("Tabelle2").Visible = True
    Windows("Check.xlsx").Activate
    Sheets("Tabelle1").Select
    Range("A1:D1").Select
    Selection.copy
    Windows(Worksheets("Tabelle1").Range("A2").Value).Activate
   
    Sheets("Tabelle2").Select
    Range("A14").Select
    ActiveSheet.Paste
    Sheets("Tabelle1").Select
    Sheets("Tabelle2").Visible = False
 
    Schutz_an
    Application.ScreenUpdating = True
   
End Sub


Ich freu mich. Es funzt.  
Zumindest so lange, bis irgendein Genie wieder was gefunden hat, was er bitte nicht machen soll. Dann muss ich wieder nachbessern und weitere Leitplanken einbauen. 
So ein Formular bietet ja reichlich Möglichkeiten um beim Ausfüllen seiner Kreativität freien lauf zu lassen. Es ist teilweise unfassbar  .
Ich glaub da kann jeder der in der IT arbeitet ein Lied von singen.