| 投稿日 | ： 2006/12/04(Mon) 16:55 |
| 投稿者 | ： たぁ |
| Ｅメール | ： |
| ＵＲＬ | ： |
| タイトル | ： Re^2: Excelのプロセスがアプリケーション起動1回目のみ残ってしまう。 |
ＹＫ様、ご返答ありがとうございます。
参照不足の可能性ですか・・・
コードを一部分載せますので、申し訳ありませんが
アドバイス願えますでしょうか？
Private Sub Excel_Save()
On Error Resume Next
Dim strExcelFolderName As String
Dim strExcelFileName As String
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
strExcelFolderName = App.Path & "\Data"
strExcelFileName = strExcelFolderName & "\" & FileName
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
xlApp.Workbooks.OpenText FileName:=strFullFileName, _
Origin:=932, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
xlApp.Columns("A:A").Select
xlApp.Selection.Insert Shift:=xlToRight
xlApp.Rows("13:13").Select
xlApp.Selection.Insert Shift:=xlDown
xlApp.Cells.Select
xlApp.Selection.Font.Size = 8
xlApp.Columns("A:A").Select
xlApp.Selection.ColumnWidth = 0.38
xlApp.Columns("B:B").Select
xlApp.Selection.ColumnWidth = 6
xlApp.Columns("C:V").Select
xlApp.Selection.ColumnWidth = 5
xlApp.Rows("5:5").Select
xlApp.Selection.RowHeight = 168
xlApp.Rows("13:13").Select
xlApp.Selection.RowHeight = 1.5
xlApp.Rows("1:1").Select
xlApp.Selection.Insert Shift:=xlDown
xlApp.Selection.RowHeight = 6
xlApp.Range("B2:B5").Select
xlApp.Selection.HorizontalAlignment = xlLeft
xlApp.Range("H2:H5,V2:V4").Select
xlApp.Range("V2").Activate
xlApp.Selection.HorizontalAlignment = xlRight
xlApp.Range("C2:D2").Select
xlApp.Selection.Merge
xlApp.Selection.HorizontalAlignment = xlRight
xlApp.Selection.Copy
xlApp.Range("C3:D5,L2:M5,Q2:R5").Select
xlApp.Range("Q2").Activate
xlApp.Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
xlApp.Range("F2:G2").Select
xlApp.Application.CutCopyMode = False
xlApp.Selection.Merge
xlApp.Selection.HorizontalAlignment = xlLeft
xlApp.Selection.Copy
xlApp.Range("F3:G5,J2:K5,O2:P5,T2:U4").Select
xlApp.Range("T2").Activate
xlApp.Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
xlApp.Range("B2:D5,F2:H5,J2:M5,O2:R5,T2:V4").Select
xlApp.Range("T2").Activate
xlApp.Application.CutCopyMode = False
xlApp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
xlApp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
・
・（中略）
・
xlApp.Range("A1").Select
xlApp.ActiveWorkbook.SaveAs FileName:=strExcelFileName & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
xlApp.Quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End Sub
こんな感じです・・・
お願いいたします。