У меня странная проблема с моим кодом. Вчера это сработало, но сегодня макрос работает вроде бы нормально, но файл не сохраняется на Sharepoint. Я не получаю ошибок.
Когда я перехожу через код, он сохраняет его. Что я заметил, так это то, что при автоматическом запуске макроса я получаю только что-то вроде «Загрузка списка контента Sharepoint» - я перевожу его.
Но при переходе я получаю второе окно с надписью «Сохранение файла».
Вот мой код:
Private Sub Workbook_Open()
On Error GoTo RefreshHandler
RefreshPQConnections
ActiveWorkbook.RefreshAll
If Format(Date, "dd.mm.yyyy") = Sheets("chart").Range("T2").Value Then
Sheets("chart").Range("Y2:Y3").ClearContents
Else
End If
Sheets("toggl_report").Activate
If Format(ActiveSheet.Range("A2").Value, "dd.mm.yyyy") <> Format(Date, "dd.mm.yyyy") Then
ElseIf ActiveSheet.Range("A2") = "" Then
MsgBox ("Old data or no data")
Else
Dim NextRow As Long
NextRow = Sheets("data_ongoing").Range("A1").End(xlDown).Row + 1
Sheets("toggl_report").Range("B2:M2").Select
Sheets("toggl_report").Range(Selection, Selection.End(xlDown)).Copy
Sheets("data_ongoing").Range("A" & NextRow).PasteSpecial xlPasteValues
Sheets("data_ongoing").Activate
ActiveWorkbook.Worksheets("data_ongoing").ListObjects("toggl_table").Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("data_ongoing").ListObjects("toggl_table").Sort. _
SortFields.Add2 Key:=Range("toggl_table[updated]"), SortOn:=xlSortOnValues, _
Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("data_ongoing").ListObjects("toggl_table").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.ListObjects("toggl_table").Range.RemoveDuplicates Columns:=Array(1), Header:=xlYes
ActiveWorkbook.Worksheets("data_ongoing").ListObjects("toggl_table").Sort. _
SortFields.Add2 Key:=Range("toggl_table[start]"), SortOn:=xlSortOnValues, _
Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("data_ongoing").ListObjects("toggl_table").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWorkbook.RefreshAll
Dim FindNo As Range
Sheets("blacklist").Activate
Dim BlacklistRange As Range
Set BlacklistRange = Range("blacklist[sent_by_email]")
Set FindNo = BlacklistRange.Find(What:="", After:=Cells(2, 11), LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If Not FindNo Is Nothing Then
ActiveSheet.ListObjects("blacklist").Range.AutoFilter Field:=11, Criteria1:= _
""
ActiveSheet.Range(Range("B1:J1"), Range("B1:J1").End(xlDown)).Select
Mail_Selection_Range_Outlook_Body
Sheets("blacklist").Activate
ThisWorkbook.Worksheets("blacklist").ShowAllData
For x = 2 To Range("I1").End(xlDown).Row
If Cells(x, 11).Value = "Yes" Then
Else
Cells(x, 11).Value = "Yes"
End If
Next
Else
End If
End If
Dim CurrentMonth As String
CurrentMonth = WorksheetFunction.Text(Date, "[$-409]mmm")
Sheets("chart").PivotTables("Tabela przestawna17").PivotFields("month"). _
CurrentPage = CurrentMonth
Call CheckThresholds
ThisWorkbook.RefreshAll
ThisWorkbook.Save
Workbooks.Open ("C:\Users\208896\Desktop\Moje Makra\toggl_live.xlsx")
Workbooks("toggl_live").Activate
Workbooks("toggl_live").RefreshAll
Workbooks("toggl_live").Save
Workbooks("toggl_live").SaveAs Filename:= _
"https://ingrammicro.sharepoint.com/sites/OG-BIGoleniowWorkspace/Shared%20Documents/Toggl%20Live/toggl_live.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Workbooks("toggl_live").Close True
ThisWorkbook.Save
Application.Quit
Exit Sub
RefreshHandler:
MsgBox ("Refresh unsucessful or other unidentified error")
End Sub