-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
+1素敵な仕事多くのコードの中で良いヒントを見つけます! – aevanko
返信いただきありがとうございます。何年も前に私たちのためにしてくれた人は、コードについて何も知らない。コードのどこに私はそれが動作するかを確認するためにあなたの提案を入れますか? – Maz
@user:あなたが私にブックを送ってほしいなら、私はそれをあなたのために修正しようとします。 ti m j j w i l l i a m s {at} g ma i ll {.com} –