VBA 代码无法在启用宏的文件类型中运行

Posted 2023-05-07

【中文标题】VBA 代码无法在启用宏的文件类型中运行

【英文标题】：VBA codes could not run in marco enabled file type

【发布时间】：2016-07-26 02:27:21

【问题描述】：

对不起，我是 VBA 的新手，感谢这里的所有专家，我能够复制一些代码并修改它们以满足我的需要。基本上，它们只是执行各种功能的几个命令按钮。它在我的 excel 2010 中运行良好。但是，当我尝试使用 Excel 2007 将文件保存在另一台计算机中时（确认 vba 正在运行），弹出一条消息说

“以下功能无法保存在无宏工作簿中：

VB 项目

要保存具有这些功能的文件，请单击否，然后选择启用宏的文件类型..."

即使我单击否，然后将其另存为 xlsm。当我打开文件时，所有的 vba 代码都被禁用了。我只是想知道这是否是由于以下任何一行代码无法在 excel 2007 中运行。非常感谢您的帮助！

为代码混乱道歉。

Private Sub CommandButton1_Click()

' Defines variables
Dim Wb1 As Workbook, Wb2 As Workbook
' Disables screen updating to reduce flicker
Application.ScreenUpdating = False
' Sets Wb1 as the current (destination) workbook
Set Wb1 = ThisWorkbook
' Sets Wb2 as the defined workbook and opens it - Update filepath / filename     as required
Set Wb2 = Workbooks.Open("\\new_admin\MASTER_FILE.xlsx")
' Sets LastRow as the first blank row of Wb1 Sheet1 based on column A (requires at least header if document is otherwise blank)
    lastrow = Sheets(1).Cells(Rows.count, "A").End(xlUp).Row + 1
' With workbook 2
        With Wb2
' Activate it
            .Activate
' Activate the desired sheet - Currently set to sheet 1, change the number         accordingly
            .Sheets(1).Activate
' Copy the used range of the active sheet
            .ActiveSheet.UsedRange.Copy
        End With
' Then with workbook 1
            With Wb1.Sheets(1)
' Activate it
                .Activate
' Select the first blank row based on column A
                .Range("A1").Select
' Paste the copied data
                .Paste
            End With
' Close workbook 2
    Wb2.Close
' Re-enables screen updating
Application.ScreenUpdating = False

End Sub

Private Sub CommandButton2_Click()

' Defines variables
Dim Wb1 As Workbook, Wb2 As Workbook
' Disables screen updating to reduce flicker
Application.ScreenUpdating = False
' Sets Wb1 as the current (destination) workbook
Set Wb1 = ThisWorkbook
' Sets Wb2 as the defined workbook and opens it - Update filepath / filename as required
Set Wb2 = Workbooks.Open("C:\Users\admin\Desktop\Accom_Master_File.xlsx")
' Sets LastRow as the first blank row of Wb1 Sheet1 based on column A (requires at least header if document is otherwise blank)
    lastrow = Sheets(2).Cells(Rows.count, "A").End(xlUp).Row + 1
' With workbook 2
        With Wb2
' Activate it
            .Activate
' Activate the desired sheet - Currently set to sheet 1, change the number accordingly
            .Sheets(1).Activate
' Copy the used range of the active sheet
            .ActiveSheet.UsedRange.Copy
        End With
' Then with workbook 1
            With Wb1.Sheets(2)
' Activate it
                .Activate
' Select the first blank row based on column A
                .Range("A1").Select
' Paste the copied data
                .Paste
            End With
' Close workbook 2
    Wb2.Close
' Re-enables screen updating
Application.ScreenUpdating = False

Dim wkb As Workbook
Set wkb = ThisWorkbook

wkb.Sheets("Sheet1").Activate

End Sub

Private Sub CommandButton3_Click()

Range("B2").CurrentRegion.Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal

ThisWorkbook.Sheets("Sheet2").Range("B:C").Delete xlUp

ThisWorkbook.Sheets("Sheet2").Columns(2).Copy
ThisWorkbook.Sheets("Sheet2").Columns(1).Insert
ThisWorkbook.Sheets("Sheet2").Columns(3).Delete

End Sub

Private Sub CommandButton4_Click()

Dim dicKey As String
Dim dicValues As String
Dim dic
Dim data
Dim x(1 To 35000, 1 To 24)
Dim j As Long
Dim count As Long
Dim lastrow As Long

lastrow = Cells(Rows.count, 1).End(xlUp).Row
 data = Range("A2:X" & lastrow) ' load data into variable
         With CreateObject("scripting.dictionary")
                For i = 1 To UBound(data)
                     If .Exists(data(i, 2)) = True Then 'test to see if the key exists
                         x(count, 3) = x(count, 3) & ";" & data(i, 3)
                         x(count, 8) = x(count, 8) & ";" & data(i, 8)
                         x(count, 9) = x(count, 9) & ";" & data(i, 9)
                         x(count, 10) = x(count, 10) & ";" & data(i, 10)
                         x(count, 21) = x(count, 21) & ";" & data(i, 21)
                     Else
                        count = count + 1
                        dicKey = data(i, 2) 'set the key
                        dicValues = data(i, 2) 'set the value for data to be stored
                        .Add dicKey, dicValues
                        For j = 1 To 24
                          x(count, j) = data(i, j)
                        Next j
                     End If
                  Next i

          End With

             Rows("2:300").EntireRow.Delete
          Sheets("Sheet1").Cells(2, 1).Resize(count - 1, 24).Value = x

End Sub

Private Sub CommandButton5_Click()

If ActiveSheet.AutoFilterMode Then Selection.AutoFilter

ActiveCell.CurrentRegion.Select

With Selection
.AutoFilter
.AutoFilter Field:=1, Criteria1:="ACTIVE"
.AutoFilter Field:=5, Criteria1:="NUMBERS"
.Offset(1, 0).Select

End With

Dim ws As Worksheet
  Dim rVis As Range

  Application.ScreenUpdating = False
  For Each ws In Worksheets
    Do Until ws.Columns("A").SpecialCells(xlVisible).count = ws.Rows.count
  Set rVis = ws.Columns("A").SpecialCells(xlVisible)
  If rVis.Row = 1 Then
    ws.Rows(rVis.Areas(1).Rows.count + 1 & ":" & rVis.Areas(2).Row -     1).Delete
  Else
    ws.Rows("1:" & rVis.Row - 1).Delete
  End If
Loop
  Next ws
  Application.ScreenUpdating = True

   Dim LR As Long
LR = Cells(Rows.count, 1).End(xlUp).Row
Rows(LR).Copy
Rows(LR + 2).Insert

End Sub

Private Sub CommandButton6_Click()

Columns("A").Delete

    Dim lastrow As Long
    lastrow = Range("A2").End(xlDown).Row

Range("X2:X" & lastrow).FormulaR1C1 = "=IF(RC[+1]=""PAYING"",     VLOOKUP(RC[-23],'Sheet2'!R1C1:R20000C8,8,0),""PENDING"")"

Range("Y2:Y" & lastrow).FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-24],'Sheet2'!R1C1:R20000C8,2,0), ""PENDING"")"

Range("Z2:Z" & lastrow).FormulaR1C1 = "=(LEN(RC[-24])-LEN(SUBSTITUTE(RC[-24], "";"", """"))+1)*1200"

Range("AA2:AA" & lastrow).FormulaR1C1 = "=VLOOKUP(RC[-26],'Sheet3'!R2C2:R220C4,2,0)"

Range("AB2:AB" & lastrow).FormulaR1C1 = "=VLOOKUP(RC[-27],'Sheet3'!R2C2:R220C4,3,0)"

Range("AC2:AC" & lastrow).FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-28],'Sheet4'!R1C1:R30C3,2,0),"""")"

Range("AD2:AD" & lastrow).FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-29],'Sheet4'!R1C4:R30C6,2,0),"""")"

Columns("X:AD").EntireColumn.AutoFit

Sheets(1).Columns(24).NumberFormat = "@"
Sheets(1).Columns(25).NumberFormat = "@"
Sheets(1).Columns(29).NumberFormat = "@"
Sheets(1).Columns(30).NumberFormat = "@"

End Sub

Private Sub CommandButton7_Click()

Sheet1.Cells.Clear

End Sub

【问题讨论】：

请检查是否在 Excel 2007 中启用了宏选项。我记得遇到过同样的问题。当时的问题是宏选项和支持加载项被禁用。

【参考方案1】：

当这样的事情发生在我身上时，我只需启动一个新工作簿并以 .xls 或 .xlsm 格式显式保存，然后将我的模块或类代码复制并粘贴到新工作簿中的新模块和类中。 -- cannot post comments yet so if this doesn't help i shall delete this answer.