| |
はじめまして。過去ログ等検索したのですが、見当たらなかったため、御教えください。
現在、ACCESSにて作成したテーブルをEXCELに出力し、それをVBAで編集しています。
処理自体は普通に進むのですが、特定の位置にあるセルの内容をシート名・ファイル名に
したいのですがうまくいきません。全くうまくいかないのではなく5回に1回くらいは
保存できたりします。また、セルの内容ではなく適当な固定名にすれば確実に
保存できるようです。
Public Sub MT_Work03A()
On Error GoTo Err_MT_Work03A
Dim oApp As Object
If Dir("D:\テンプレート\作業場\O03.xls") = "" Then
MsgBox "コールが存在しません。"
Else
Set oApp = CreateObject("Excel.Application")
oApp.Visible = True
'Only XL 2002 supports UserControl Property
On Error Resume Next
oApp.UserControl = True
'ファイルを開く
oApp.Workbooks.Open Filename:="D:\テンプレート\作業場\O03.xls"
Dim myLastRow As Long
Dim myLastCol As Integer
Dim i As Long
'----最終行
myLastRow = oApp.Range("A1").End(xlDown).Row
'----最終列
myLastCol = oApp.Range("A1").End(xlToRight).Column
i = myLastRow
k = myLastCol
＜＜＜罫線を引いたりの処理の後・・・＞＞＞
oApp.Sheets("_O03").Select
oApp.Sheets("_O03").Name = Cells(i + 1, k - 17).Value
oApp.Range("A1:A2").Select
'ファイルを閉じる
oApp.Workbooks("O03.xls").Activate
oApp.ActiveWorkbook.SaveAs Filename:=("D:\" & Year(Date) & "年" & Month(Date) & "C" & "\Organization\" & Cells(i + 1, k - 17).Value & "-" & Format(Date, "mmmyyyy") & ".xls")
oApp.Workbooks("O03.xls").Activate
oApp.DisplayAlerts = False
oApp.Workbooks("O03.xls").Save
oApp.ActiveWorkbook.Close
'Excelを閉じる
oApp.Quit
oApp.DisplayAlerts = True
oApp.DisplayAlerts = True
End If
Exit_MT_Work03A:
Exit Sub
Err_MT_Work03A:
MsgBox Err.Description
Resume Exit_MT_Work03A
End Sub
すいません。全く分からないので是非お知恵をお貸しください。
宜しくお願いいたします。
|
|
![[未読]](./data/access/image/read_icon.gif){kind=icon}
