Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


12664 / 13645 ツリー ←次へ | 前へ→

【9286】保存先&キャンセル時のエラー テーブル 03/11/26(水) 21:24 質問
【9293】Re:保存先&キャンセル時のエラー りん 03/11/27(木) 7:45 発言
【9303】Re:保存先&キャンセル時のエラー テーブル 03/11/27(木) 16:01 質問
【9306】Re:保存先&キャンセル時のエラー テーブル 03/11/27(木) 18:02 質問
【9307】Re:保存先&キャンセル時のエラー こうちゃん 03/11/27(木) 18:39 回答
【9308】Re:保存先&キャンセル時のエラー テーブル 03/11/27(木) 18:58 お礼

【9286】保存先&キャンセル時のエラー
質問  テーブル  - 03/11/26(水) 21:24 -

引用なし
パスワード
   質問1)
下記のプログラムは、CSVを読み込み、その際に、リネームをして保存します。その保存先は指定できないのでしょうか?また、どう指定すればよろしいでしょうか。例えばデスクトップ上に保存する場合。

質問2)
下記のプログラムを動かしたら、どのファイルを読み込むかどうかのBOXがでてきます。
 そこで、「いいえ」を選ぶと、エラーが表示され「F」と呼ばれるEXCELファイルができてしまうのですが、ここでのエラー処理で、何か良い案はないでしょうか・・・・・

どうかお知恵をお貸しください。よろしくお願いたします。

Public Sub onActionCSV()

Dim rFile As Variant
Dim sFile As Variant
Application.EnableEvents = False

rFile = Application.GetOpenFilename
'同じ名前で拡張子を変更
sFile = Left(rFile, Len(rFile) - 4) & ".xls"
ActiveWorkbook.SaveAs Filename:=sFile, _
          FileFormat:=xlWorkbookNormal

  With ActiveSheet.QueryTables.Add(Connection:= _
    "TEXT;" & rFile, Destination:=Range("A2"))
    .Name = "R123-2-1"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = xlWindows
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = True
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, _
    2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1)
    .Refresh BackgroundQuery:=False
  End With
  Application.EnableEvents = True

End Sub

【9293】Re:保存先&キャンセル時のエラー
発言  りん E-MAIL  - 03/11/27(木) 7:45 -

引用なし
パスワード
   テーブル さん、おはようございます。

>質問2)
> そこで、「いいえ」を選ぶと、エラーが表示され「F」と呼ばれるEXCELファイルができてしまうのですが、ここでのエラー処理で、何か良い案はないでしょうか・・・・・

キャンセル時の分岐の一例です。
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=9216;id=excel

【9303】Re:保存先&キャンセル時のエラー
質問  テーブル  - 03/11/27(木) 16:01 -

引用なし
パスワード
   ▼りん さん:
りんさんお疲れ様です。
今朝はありがとうございました。色々調べてみましたが、どうしていいかわかりません。
また、下記のURLを見ましたが、難しくてほとんど何を書いてあるのか・・・

エラー処理自体はじめて試みてみるので・・・ 恐縮ですが、もう少し教えて頂けないでしょうか?

【9306】Re:保存先&キャンセル時のエラー
質問  テーブル  - 03/11/27(木) 18:02 -

引用なし
パスワード
   下記のエラー処理をしたのですが、「キャンセル」後の「F」と言うファイルが作成されるのは、変わらなかったです。何か間違いがありますかね・・・・

rFile = Application.GetOpenFilename
'同じ名前で拡張子を変更
sFile = Left(rFile, Len(rFile) - 4) & ".xls"
  On Error Resume Next    'エラーが発生しても処理を続行する
   ActiveWorkbook.SaveAs Filename:=sFile, FileFormat:=xlNormal, CreateBackup:=False
  On Error GoTo 0       'エラー処理ルーチンを無効にする

【9307】Re:保存先&キャンセル時のエラー
回答  こうちゃん E-MAIL  - 03/11/27(木) 18:39 -

引用なし
パスワード
   テーブルさん、こんにちは
りんさんがまだご覧になっていないようなので・・

>下記のエラー処理をしたのですが、「キャンセル」後の「F」と言うファイルが作成されるのは、変わらなかったです。何か間違いがありますかね・・・・
>
>rFile = Application.GetOpenFilename
>'同じ名前で拡張子を変更
>sFile = Left(rFile, Len(rFile) - 4) & ".xls"
>  On Error Resume Next    'エラーが発生しても処理を続行する
>   ActiveWorkbook.SaveAs Filename:=sFile, FileFormat:=xlNormal, CreateBackup:=False
>  On Error GoTo 0       'エラー処理ルーチンを無効にする

この場合エラーは発生していませんので、上記は無効です。
またもしエラーの場合でもエラーを無視してActiveWorkbook.SaveAs を実行しますから結果はおなじことになります。

りんさんが例示したURLでは GetOpenFilename がキャンセルされた場合にFalseがもどるので、それを使用して分岐する例です。
テーブルさんの最初のコードでいえば・・

>rFile = Application.GetOpenFilename

If Not rFile Then
  Exit Sub
End If

>sFile = Left(rFile, Len(rFile) - 4) & ".xls"
>ActiveWorkbook.SaveAs Filename:=sFile, _

こんな感じでrFileを判定します。
(rFile = False の方がわかりやすいかな)

りんさん、横レスごめんなさい。   

【9308】Re:保存先&キャンセル時のエラー
お礼  テーブル  - 03/11/27(木) 18:58 -

引用なし
パスワード
   ▼こうちゃん さん:
どうもありがとうございました。エラーの発生どころもわかってなかったですね・・・
本当に助かりましたTT

12664 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free