2011-12-13 2 views
-1

Excel 2003에서 완벽하게 잘 작동하는 통합 문서를 내보내는 매크로가 있습니다. 그러나 2007 또는 2010 컴퓨터에서는 작동하지 않습니다. 그것은 실행하고 Save As 상자를 엽니 다,하지만 내가 입력하면, 내가 확인을 클릭하면, 그냥 거기 앉아있다. 저장하려면 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

부지,하지만 단 한 가지가 2003 년 엑셀 2007의 변화에 ​​관한 밖으로 점프는, 그것은 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 
+0

+1 좋은 일 많은 코드들 사이에서 좋은 팁을 발견! – aevanko

+0

답장을 보내 주셔서 감사합니다. 몇 년 전에 우리를 위해했던 사람은 코드에 대해 아무 것도 모른다. 코드에서 어디에서 작동하는지 확인하기 위해 제안 사항을 넣을 수 있습니까? – Maz

+0

@user : 내게 통합 문서를 보내고 싶다면 그것을 고치려고 노력할 것입니다. t i m j j w i l l i a m s {at} g ma i {.com} –