Question

我有一个导出工作簿的宏，它在Excel 2003下工作得很好（并且有多年）。但是，它不适用于2007或2010的任何机器。它运行并打开{{1} }但是无论我输入什么，当我点击确定时，它就在那里。单击Save As进行保存不会执行任何操作。有人可以帮忙吗？

代码：

Ok

Answer 1

那里有很多代码，但只有一件事情与Excel 2007中的更改有关。2003年，如果将工作表复制到另一个位置，它曾经成为ActiveSheet。不会在2007年以后发生，因此您需要重新编写代码以明确引用该副本。

例如：

Dim shtCopy as Worksheet

'copy a sheet
ThisWorkbook.Sheets("Template").Copy After:=Thisworkbook.Sheets("Data")
'get a reference to the copy
Set shtCopy = ThisWorkbook.Sheets(Thisworkbook.Sheets("Data").Index+1)

编辑：你真的意味着这个

num_sheets = Workbooks.Count

而不是

num_sheets = ActiveWorkbook.Sheets.Count

编辑：最好我猜这应该适合你

Sub ExportReports()

    Static varfile_name As String
    Static strpassword As String

    'Dim fdialog As Office.FileDialog
    Dim varfile As String
    Dim prog_name As String
    Dim curr_wb As Workbook
    Dim selected_wb As Workbook

    Dim xflag As String
    Dim n As Integer

    Set curr_wb = ActiveWorkbook
    prog_name = curr_wb.Worksheets("Menu").Range("F14")

    'Set fdialog = Application.FileDialog(msoFileDialogFilePicker)
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Please select or create the file you wish to export reports to"
        .Filters.Clear
        .Filters.Add "Microsoft Excel Files", "*.xlsx"
        If .Show = True Then
            varfile = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With

    If strpassword = "" Then
       strpassword = InputBox("Enter a password to protect worksheets in this file")
    End If

    'tw Not sure what the purpose of this is?
    '  by default it will select the *previous* selected wb...
    For n = 1 To Application.Workbooks.Count
       If Workbooks(n).Name = varfile_name Then
         Set selected_wb = Workbooks(n)
         Exit For 'break out of loop
       End If
    Next

    If selected_wb Is Nothing Then
       Set selected_wb = Workbooks.Open(Filename:=varfile, UpdateLinks:=0)
    End If

    varfile_name = selected_wb.Name
    xflag = "a"
    If selected_wb.Sheets(1).Name = "Invoice" Then
       xflag = xflag & "b"
    End If
    If selected_wb.Sheets(2).Name = "All Programs" Then
       xflag = xflag & "c"
    End If

    Select Case xflag
    Case "a" ' Both Invoice and All Programs must be exported

        CopySheet curr_wb.Sheets("Invoice"), _
                  selected_wb, 1, "", strpassword

        CopySheet curr_wb.Sheets("Preview All Programs"), _
                  selected_wb, 2, "All Programs", strpassword

    Case "ab" ' Only All Programs must be exported

        CopySheet curr_wb.Sheets("Preview All Programs"), _
                  selected_wb, 3, "All Programs", strpassword

    Case "ac" ' Only invoice must be exported

        CopySheet curr_wb.Sheets("Invoice"), _
                  selected_wb, 2, "", strpassword

    End Select

    CopySheet curr_wb.Sheets("Preview"), _
                  selected_wb, 3, prog_name, strpassword


    curr_wb.Activate
    curr_wb.Worksheets("Menu").Activate

    'selected_wb.Close

End Sub

'Copy sheet to specific position, convert to values,
'  change name
Sub CopySheet(wsToCopy As Worksheet, destWb As Workbook, _
              destPos As Integer, newName As String, pw As String)
    Dim shtCopy As Worksheet

    If destPos = 1 Then
        wsToCopy.Copy Before:=destWb.Sheets(1)
    Else
        wsToCopy.Copy After:=destWb.Sheets(destPos - 1)
    End If
    With destWb.Sheets(destPos)
        .UsedRange.Value = .UsedRange.Value
        If Len(newName) > 0 Then .Name = newName
        .Protect Password:=pw, Scenarios:=True
        .Range("A1").Select
    End With
End Sub

宏在Excel 2003中工作，而不是在2007年

1 个答案: