Microsoft Sicherheitswarnung - "umgehen"
25.02.2019 18:37:36
Markus
mit folgendem Code kann ich bestimmte Tabellenblätter aus verschiedenen Mappen zusammenfassen. Danke nochmal an Bernd (hier aus dem Forum) für seine Hilfe. Der Code funktioniert einwandfrei, jedoch befinden sich meine Mappen auf dem SharePoint und es kommt daher immer die Sicherheitswarnung von Microsoft i.S.v. "stammen die Daten aus einer vertrauenswürdigen Quelle". Das Problem ist, dass sobald ich dies mit Ja oder Nein beantworte, läuft das Makro nicht weiter und wird beendet.
Gibt es eine Möglichkeit, diese Sicherheitsabfrage zu "umgehen". Sprich, das Makro öffnet die Dateien dann kommt die Sicherheitsabfrage, die man selbstständig bestätigt und das Makro läuft weiter.
Vielen Dank euch!
Hier noch der Code
Userform:
Option Explicit
Private Sub ComboBox1_Change()
If Me.ComboBox1.Value = "" Then
Monat = ""
Me.CommandButton1.Enabled = False
Else
Select Case Me.ComboBox1.Value
Case Is = "Januar"
Monat = "01"
Case Is = "Februar"
Monat = "02"
Case Is = "März"
Monat = "03"
Case Is = "April"
Monat = "04"
Case Is = "Mai"
Monat = "05"
Case Is = "Juni"
Monat = "06"
Case Is = "Juli"
Monat = "07"
Case Is = "August"
Monat = "08"
Case Is = "September"
Monat = "09"
Case Is = "Oktober"
Monat = "10"
Case Is = "November"
Monat = "11"
Case Is = "Dezember"
Monat = "12"
End Select
Me.CommandButton1.Enabled = True
End If
End Sub
Private Sub CommandButton1_Click()
Call Blätter_löschen
Call test(Monat)
Unload Me
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
With Me.ComboBox1
.AddItem "Januar"
.AddItem "Februar"
.AddItem "März"
.AddItem "April"
.AddItem "Mai"
.AddItem "Juni"
.AddItem "Juli"
.AddItem "August"
.AddItem "September"
.AddItem "Oktober"
.AddItem "November"
.AddItem "Dezember"
End With
Me.CommandButton1.Enabled = False
End Sub
Modul:
Option Explicit
Dim ws As Worksheet
Dim WBZ As Workbook
Dim WBA As Workbook
Dim WBB As Workbook
Dim WBC As Workbook
Dim wsr As Worksheet
Public Monat As String
Dim intIndex As Integer
Dim Punkt As Integer
Sub test(ByRef Monat As String)
Set WBZ = ThisWorkbook
Set WBA = Workbooks.Open("C:\Test\TestA.xlsx") ' Pfad der Datei anpassen!!!
Set WBB = Workbooks.Open("C:\Test\TestB.xlsx") ' Pfad der Datei anpassen!!!
Set WBC = Workbooks.Open("C:\Test\TestC.xlsx") ' Pfad der Datei anpassen!!!
WBZ.Activate
With WBA
For Each ws In WBA.Worksheets
If InStr(1, ws.Name, Monat, vbTextCompare) > 0 Then
Punkt = InStr(1, WBA.Name, ".", vbBinaryCompare)
intIndex = ws.Index
End If
Next ws
If intIndex 12 Then
MsgBox "Fehler: Tabellenblatt " & Monat & " konnte nicht gefunden werden!" & vbNewLine & "Der Programmablauf wird abgebrochen", vbCritical, "Fehler"
WBA.Close False
WBB.Close False
WBC.Close False
Exit Sub
End If
Set wsr = WBA.Sheets(intIndex)
wsr.Copy after:=WBZ.Sheets(Sheets.Count)
ActiveSheet.Name = Left(WBA.Name, Punkt - 1) & "_" & Monat
Set wsr = Nothing
.Close False
End With
With WBB
Punkt = InStr(1, WBB.Name, ".", vbBinaryCompare)
Set wsr = WBB.Sheets(intIndex)
wsr.Copy after:=WBZ.Sheets(Sheets.Count)
ActiveSheet.Name = Left(WBB.Name, Punkt - 1) & "_" & Monat
Set wsr = Nothing
.Close False
End With
With WBC
Punkt = InStr(1, WBC.Name, ".", vbBinaryCompare)
Set wsr = WBC.Sheets(intIndex)
wsr.Copy after:=WBZ.Sheets(Sheets.Count)
ActiveSheet.Name = Left(WBC.Name, Punkt - 1) & "_" & Monat
Set wsr = Nothing
.Close False
End With
Set WBA = Nothing
Set WBB = Nothing
Set WBC = Nothing
WBZ.Activate
Set WBZ = Nothing
Set ws = Nothing
End Sub Sub Blätter_löschen()
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Worksheets
If ws.Name "Reporting" Then ws.Delete
Next ws
Application.DisplayAlerts = True
End Sub
Anzeige