2011-12-13 6 views
-1

Excel 2003で完璧に動作するブックをエクスポートするマクロがありますが、2007または2010のいずれのマシンでも動作しません。それは実行され、Save Asボックスを開きますが、私が何を入力してもOKをクリックすると、ただそこに座ります。保存するにはOkをクリックしても何もしません。誰か助けてもらえますか?マクロは2007年ではなくExcel 2003で動作します

コード:そこコードの

Sub ExportReports() 

Dim fdialog As Office.FileDialog 
Dim varfile As String 

Static varfile_name As String 
Dim curr_wb_name As String 
Dim num_sheets As Integer 
Dim xflag As String 
Dim openflag As Boolean 
Static strpassword As String 


'check to see if invoice has been moved 
'check to see if all programs report has been moved 
'move specified report 


'User selects the file containing the budget - must be in set format 
'Changes to the format of budget spreadsheet are likely to affect this code 

curr_wb_name = ActiveWorkbook.Name 
prog_name = ActiveWorkbook.Worksheets("Menu").Range("F14") 

lineselectfile: 
Set fdialog = Application.FileDialog(msoFileDialogFilePicker) 

With fdialog 
    .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 
     'MsgBox "You must select a file to import, please try again", _ 
     '  vbOKOnly, "Import Error!" 
     'GoTo lineselectfile 
    End If 
End With 

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

n = 0 
For n = 1 To Workbooks.Count 
    If Workbooks(n).Name = varfile_name Then 
    openflag = True 
    Workbooks(n).Activate 
    End If 
Next 

If openflag = False Then 
    Workbooks.Open Filename:=varfile, UpdateLinks:=0 
End If 

varfile_name = ActiveWorkbook.Name 
num_sheets = Workbooks.Count 
'n = 0 
xflag = "a" 
'Do Until n = num_sheets 
If Sheets(1).Name = "Invoice" Then 
    xflag = xflag & "b" 
End If 
If Sheets(2).Name = "All Programs" Then 
    xflag = xflag & "c" 
End If 
'n = n + 1 
'Loop 

Select Case xflag 
Case "a" ' Both Invoice and All Programs must be exported 
    Windows(curr_wb_name).Activate 
    Sheets("Invoice").Select 
    Sheets("Invoice").Copy before:=Workbooks(varfile_name).Sheets(1) 
    Cells.Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False _ 
    , Transpose:=False 
    ActiveSheet.Protect Password:=strpassword, Scenarios:=True 
    Range("a1").Select 
    Windows(curr_wb_name).Activate 
    Sheets("Preview All Programs").Select 
    Sheets("Preview All Programs").Copy before:=Workbooks(varfile_name).Sheets(2) 
    Cells.Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False _ 
    , Transpose:=False 
    Sheets("Preview All Programs").Name = "All Programs" 
    ActiveSheet.Protect Password:=strpassword, Scenarios:=True 
    Range("a1").Select 
Case "ab" ' Only All Programs must be exported 
    Windows(curr_wb_name).Activate 
    Sheets("Preview All Programs").Select 
    Sheets("Preview All Programs").Copy After:=Workbooks(varfile_name).Sheets(2) 
    Cells.Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False _ 
    , Transpose:=False 
    Sheets("Preview All Programs").Name = "All Programs" 
    ActiveSheet.Protect Password:=strpassword, Scenarios:=True 
    Range("a1").Select 
Case "ac" ' Only invoice must be exported 
    Windows(curr_wb_name).Activate 
    Sheets("Invoice").Select 
    Sheets("Invoice").Copy After:=Workbooks(varfile_name).Sheets(1) 
    Cells.Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False _ 
    , Transpose:=False 
    ActiveSheet.Protect Password:=strpassword, Scenarios:=True 
    Range("a1").Select 

End Select 
    Windows(curr_wb_name).Activate 
    Sheets("Preview").Select 
    Sheets("Preview").Copy After:=Workbooks(varfile_name).Sheets(2) 
    Cells.Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False _ 
    , Transpose:=False 
    Sheets("Preview").Name = prog_name 
    ActiveSheet.Protect Password:=strpassword, Scenarios:=True 
    Range("a1").Select 
    Windows(curr_wb_name).Activate 
    Worksheets("Menu").Activate 
    'Workbooks(varfile_name).Close 

End Sub 

答えて

3

ロット1つだけの事はあなたが別の場所にシートをコピーした場合、それはActiveSheetになるために使用され、2003年にはエクセル2007での変更に関する飛び出します。そのは、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 
+0

+1素敵な仕事多くのコードの中で良いヒントを見つけます! – aevanko

+0

返信いただきありがとうございます。何年も前に私たちのためにしてくれた人は、コードについて何も知らない。コードのどこに私はそれが動作するかを確認するためにあなたの提案を入れますか? – Maz

+0

@user:あなたが私にブックを送ってほしいなら、私はそれをあなたのために修正しようとします。 ti m j j w i l l i a m s {at} g ma i ll {.com} –

関連する問題