首页 > 解决方案 > 要求在没有宏的工作簿中启用宏

问题描述

宏将工作表复制到新创建的工作簿中,我发送了这个没有宏的报告。

但是,我的客户说她必须打开文件才能启用宏,然后重新保存。她说她有一个“与报告相关的文件”,所以很有可能。从关闭的报告中提取数据的程序。她还给我发了一张她的屏幕照片,上面有一个黄色的小条,提示她该文件处于受保护的视图中。

我的代码中有什么原因可以解释这种情况吗?

这是我的代码:

Sub Generate_Position_Report()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 

Application.Calculate
Do While Application.CalculationState <> xlDone
     DoEvents
Loop

''''''''' Open Previous Report '''''''''
Dim d As Date
d = DateAdd("d", -1, Date)
Dim d3 As Date
d3 = d - 2

Dim prev_file As String
Dim prev_file_exists As String

prev_file = "X:\Risk\Departmental\Reporting\Position Report " & Format(d, "yyyy-mm-dd") & ".xlsx"
prev_file_exists = Dir(prev_file)
    
    If prev_file_exists <> "" Then
        Workbooks.Open Filename:="X:\Risk\Departmental\Reporting\Position Report " & Format(d, "yyyy-mm-dd") & ".xlsx"
    Else
        Workbooks.Open Filename:="X:\Risk\Departmental\Reporting\Position Report " & Format(d3, "yyyy-mm-dd") & ".xlsx"
    End If

ThisWorkbook.Activate

''''''''' Variables '''''''''
sim_date = Range("SIM_DATE").Value
main_analysis_name = Range("MAIN_ANALYSIS_NAME").Value
secondary_analysis_name = Range("SECONDARY_ANALYSIS_NAME").Value
previous_workday = Range("PREVIOUS_WORKDAY").Value
t_minus_2_workday = Range("T_MINUS_2_WORKDAY").Value
previous_day_quotes = Range("PREVIOUS_DAY_QUOTES").Value
t_minus_2_quotes = Range("T_MINUS_2_DAY_QUOTES").Value
price_curves_analysis = Range("PRICE_CURVES_ANALYSIS").Value
previous_analysis_date = Range("PREVIOUS_ANALYSIS_DATE").Value
previous_analysis_name = Range("PREVIOUS_ANALYSIS_NAME").Value
col_shift = Range("COL_SHIFT").Value

Application.DisplayAlerts = False

''''''''' Recalculate Data '''''''''
Application.Calculate
Do While Application.CalculationState <> xlDone
     DoEvents
Loop

'''''''''' Save the Template ''''''''''
'good practice to turn things back on for the template'
Application.DisplayAlerts = True
Application.ScreenUpdating = True

ThisWorkbook.Save

'we need to turn them off again to finalize the report'
Application.DisplayAlerts = False
Application.ScreenUpdating = False

'''''''''' Copy/Paste Values ''''''''''
'we need to copy and paste values for all the worksheets'
For Each ws In Worksheets
    Sheets(ws.Name).Activate
    Sheets(ws.Name).Cells.Copy
    Sheets(ws.Name).Cells.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Sheets(ws.Name).Cells(1, 1).Select  
Next

'''''''''' Create Fresh Copy Without Macros ''''''''''
ThisWorkbook.Sheets.Copy
Application.DisplayAlerts = False
Application.ScreenUpdating = False
ActiveWorkbook.SaveAs Filename:="X:\Risk\Departmental\Reporting\Position Report (TEST) " & Format(d + 1, "yyyy-mm-dd") & ".xlsx", FileFormat:=51

'physically breaking links'
Dim wb As Workbook
Set wb = Application.ActiveWorkbook
If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
    For Each link In wb.LinkSources(xlExcelLinks)
        wb.BreakLink link, xlLinkTypeExcelLinks
    Next link
End If

'''''''''' Activate/Hide/Delete Tabs ''''''''''
Worksheets("Control").Visible = False
Worksheets("Reference").Visible = False
Worksheets("HERITAGE Summary").Activate

'turning back on some features for the active/report'
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

ActiveWorkbook.Save 'saving the report'
Workbooks(2).Close 'closes the prev. file'
ThisWorkbook.Close savechanges:=False 'closes the template'

End Sub

标签: excelvba

解决方案


推荐阅读