VBA代码无法在启用marco的文件types中运行
对不起，我是VBA新手，感谢所有的专家，我可以复制一些代码，并修改它们以适应我的需要。 基本上，它们只是一些执行各种function的命令button。 它在我的excel 2010工作得很好。但是，当我尝试保存在另一台计算机与Excel 2007中的文件（确认VBA正在运行），一个消息popup窗口说
“以下function无法保存在无macros工作簿中：
VB项目
要保存具有这些function的文件，请单击否，然后select启用macros的文件types…“
即使我点击了否，然后保存为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 当这样的事情发生在我身上时，我只是启动一个新的工作簿，并以.xls或.xlsm格式显式保存，然后将我的模块或类代码复制并粘贴到新工作簿中的新模块和类中。 -- cannot post comments yet so if this doesn't help i shall delete this answer.