Question

我有一段代码是从与我的Excel连接的Google日历中提取日历事件的。它运行完美，但是每次我添加代码来更新某个工作表（“日历”），保存并关闭时。下次我再次打开文件时，系统提示以下消息：我们发现'.xlsm'中的某些内容存在问题。您是否希望我们尽力恢复原状？如果您信任此工作簿的来源，请单击“是”。

请注意，只有当我添加以下内容时，才会发生这种情况：工作簿的Sheets（“ Calendar”）。Calculate或Application.Calculation = xlAutomatic。我还尝试引入一个复选框，并且仅当该复选框被选中并且宏已运行时，才会更新工作表。那提示了同样的错误。如果没有计算代码，则不会弹出此消息。

我很困惑，找不到类似的情况，原因是工作表计算。感谢您的帮助。

没有任何代码丢失或更改，文件仅显示为[Repaired]

    Sub listlist()
Dim olApp As Object, olNS As Object, olFolder As Object, olApt As Object, NextRow As Long, FromDate As Date, ToDate As Date, z As Integer, num As Integer
Sheets("Calendar").Columns("A:B").ClearContents

num = ActiveSheet.Cells(1, 1).Value - month(Now)
FromDate = WorksheetFunction.EoMonth(Date, 0 + num) + 1
ToDate = WorksheetFunction.EoMonth(Date, 1 + num)


On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err.Number > 0 Then Set olApp = CreateObject("Outlook.Application")
On Error GoTo 0

Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.Folders("Internet Calendars").Folders("Calend")

NextRow = 2


With Sheets("Calendar")
    .Range("A1:C1").Value = Array("Project", "Date", "First Trim")
    For Each olApt In olFolder.Items
        If (olApt.Start >= FromDate And olApt.Start <= ToDate) Then
            .Cells(NextRow, "A").Value = olApt.subject
            .Cells(NextRow, "B").Value = CDate(olApt.Start)
            NextRow = NextRow + 1
        Else
        End If
    Next olApt
    .Columns.AutoFit
End With

Set olApt = Nothing
Set olFolder = Nothing
Set olNS = Nothing
Set olApp = Nothing

'Sort
Dim Lastrow As Integer
Lastrow = Sheets("Calendar").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Calendar").Sort.SortFields.Add2 Key:=Range("B2").End(xlDown) _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Worksheets("Calendar").Sort
    .SetRange Range(Cells(1, 1), Cells(Lastrow, 3))
    .Header = xlYes
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With


Sheets("Calendar").Calculate


'Update Meeting dates

    z = 3

    For j = 2 To 20
        If Sheets("Calendar").Cells(j, 5).Value <> "" Then
        For I = 2 To 160
            If Sheets("Consultants").Cells(I, 15).Value = Sheets("Calendar").Cells(j, 5).Value Then
                For h = 9 To 160
                    If Sheets("Consultants").Cells(I, 1).Value = ActiveSheet.Cells(h, 2).Value Then
                        ActiveSheet.Cells(h, 4).Value = Sheets("Calendar").Cells(j, 2).Value
                        Exit For
                    End If
                Next h
            End If
        Next I
        End If
    Next j

End Sub

Answer 1

我通过使用@FunThomas的建议解决了此问题。我从头开始工作簿，并做了以下事情：

-通过vba输入的公式，而不是将公式中的单元格留在excel中更改了清除列A和B以清除所有单元格，因为我知道手动输入公式

通过这样做，我不再需要计算工作表。我没有在工作簿中测试实现计算机的实现，我不想冒任何损坏的风险。

每次我自动计算工作表时，为什么会出现“我们在'.xlsm'中发现某些内容的问题”消息？

1 个答案: