VBA-Codes konnten nicht im marco-fähigen Dateityp ausgeführt werden

Question

Entschuldigung, dass ich neu bei VBA bin, danke an alle Experten hier bin ich in der Lage, einige der Codes zu kopieren und sie an meine Bedürfnisse anzupassen. Sie sind im Grunde nur ein paar Befehlsknöpfe, die verschiedene Funktionen ausführen. Es funktioniert gut in meinem Excel 2010. Wenn ich jedoch versuche, die Datei auf meinem anderen Computer mit Excel 2007 zu speichern (bestätigt, dass vba läuft), eine Meldung Popup-Meldung

"Die folgenden Funktionen können nicht in einem gespeichert werden Makro freien Arbeitsmappe:

VB Projekt

Um eine Datei mit diesen Features finden Sie nicht, zu speichern und dann einen Makro-fähiger Dateityp wählen ...“

Auch klickte ich nicht und speichern es als xlsm. Wenn ich die Datei öffne, sind alle VBA-Codes deaktiviert. Ich frage mich nur, ob es aufgrund einer Zeile der folgenden Codes, die nicht in Excel 2007 ausgeführt werden konnte. Vielen Dank für Ihre Hilfe!

Entschuldigung für die Codes, die ein Durcheinander sind.

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 

Answer 1

Wenn so etwas zu mir passiert, ich starte nur eine neue Arbeitsmappe und explizit in .xls oder XLSM-Format speichern und dann mein Modul oder Klassencode in neue Module und Klassen in der neuen Arbeitsmappe kopieren und einfügen . -- cannot post comments yet so if this doesn't help i shall delete this answer.