こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

エクセルVBAでブックを開くと処理が終わってしまう

VBA初心者なのですが、VBAでエクセルブックを開くとVBAの処理が終わってしまいます。理由がわからないのでアドバイスをお願いします。なお、止まってしまう箇所にコメントを入れプログラムを下記しました。また、4000字以上質問できないためプログラムの途中までしか書かれていません。そのため、余分な宣言が多数ありますが無視してください。よろしくお願いいたします。
Option Base 1
Sub 健康診断の郵送()
Dim kyoNum() As String
Dim b_name As String
Dim a_name() As Variant
Dim b_address As String
Dim a_address() As Variant
Dim mailNum() As Variant
Dim place() As String
Dim banchi() As String
Dim ken() As String
Dim Adr As String
Dim AdrLen As Integer
Dim i, j, k, cnt, l, m As Integer
Dim ChrCode As Integer
Dim cell As Range
Dim Book1 As String
Dim wb As Workbook
Dim Book1_Path As String
Dim flag As Boolean
'セルのクリア
ThisWorkbook.ActiveSheet.Cells.ClearComments
'セルのプロパティを設定をする
With ThisWorkbook.ActiveSheet.Columns("A:B")
.ShrinkToFit = True
.NumberFormatLocal = "@"
.ColumnWidth = 45
End With

'カレントディレクトリのチェンジ(Windows2000以降)
CreateObject("WScript.Shell").CurrentDirectory = ThisWorkbook.Path
'簡易名称Book1にする
Book1 = "Book1.xlsx"
'パスを取得する
Book1_Path = ThisWorkbook.Path & "\" & Book1
If Dir(Book1_Path) = "" Then
MsgBox "Book1.xlsxファイルが存在しません。", vbExclamation
End If
'同名ブックのチェック
For Each wb In Workbooks
If wb.Name = Book1 Then
MsgBox "健康診断の郵送.xlsmはBook1を開こうとしています" _
& vbCrLf & "Book1を閉じて再実行してください", vbExclamation
Exit Sub
End If
Next wb
Application.ScreenUpdating = False
'画面の更新を止める
Workbooks.Open Book1_Path '*****←ここで処理が終わってしまう*****
'ブック名を指定して非表示
Application.Windows("Book1.xlsx").Visible = False
'後方検索でBook1.xlsxの入力済みセルの行数と列数を取得
With Workbooks("Book1.xlsx").ActiveSheet.UsedRange
Book1_MaxRow = .Find("*", , xlValues, , xlByRows, xlPrevious).Row - 2 'データ入力済み行数取得
End With
Application.ScreenUpdating = True
Workbooks("Book1.xlsx").Activate
j = 1
ReDim kyoNum(Book1_MaxRow)
ReDim a_name(Book1_MaxRow)
ReDim a_address(Book1_MaxRow)
ReDim mailNum(Book1_MaxRow)
ReDim ken(Book1_MaxRow)
ReDim place(Book1_MaxRow)
ReDim banchi(Book1_MaxRow)

投稿日時 - 2011-12-29 21:03:26

QNo.7215692

すぐに回答ほしいです

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(1)

ANo.1

>なお、止まってしまう箇所...
ここで、エラーメッセージが出て止まってしまうという意味ですか。
何というエラーメッセージでしょう?
実行時エラー1004なら、存在しないBookを開こうとしていませんか?

MsgBox "Book1.xlsxファイルが存在しません。"
の表示後に Exit Sub でマクロ終了処理をしていませんから
Bookが存在しない場合でもマクロ継続してしまうような記述になっています。
確認してください。



また、目的のSheetが必ずActiveになっている保障があるなら
ActiveSheet指定で良いかもしれませんが、再考の余地ありです。
それにCurrentDirectory変更の必要性もハテナです。
Book1_MaxRow を得るところまでをまとめてみると以下のような感じかと。

Sub try()
  Dim wb      As Workbook
  Dim r      As Range
  Dim Book1    As String
  Dim Book1_Path  As String
  Dim Book1_MaxRow As Long

  With ThisWorkbook.ActiveSheet
    .UsedRange.ClearContents
    With .Columns("A:B")
      .ShrinkToFit = True
      .NumberFormatLocal = "@"
      .ColumnWidth = 45
    End With
  End With

  Book1 = "Book1.xlsx"
  Book1_Path = ThisWorkbook.Path & "\" & Book1
  If Dir(Book1_Path) = "" Then
    MsgBox "Book1.xlsxファイルが存在しません。", vbExclamation
    Exit Sub
  End If
  For Each wb In Workbooks
    If wb.Name = Book1 Then
      MsgBox "健康診断の郵送.xlsmはBook1を開こうとしています" & vbCrLf _
         & "Book1を閉じて再実行してください", vbExclamation
      Set wb = Nothing
      Exit Sub
    End If
  Next wb

  Application.ScreenUpdating = False
  Set wb = Workbooks.Open(Book1_Path)
  wb.Windows(1).Visible = False
  'Book1_MaxRow = wb.ActiveSheet.UsedRange.Find("*", , xlValues, , xlByRows, xlPrevious).Row - 2
  Set r = wb.ActiveSheet.UsedRange.Find("*", , xlValues, xlPart, xlByRows, xlPrevious)
  If r Is Nothing Then
    MsgBox "ActiveSheetのデータ要確認"
    wb.Windows(1).Visible = True
    wb.Activate
  Else
    Book1_MaxRow = r.Row - 2
  End If

  Application.ScreenUpdating = True
  Set r = Nothing
  Set wb = Nothing
End Sub

投稿日時 - 2012-01-06 16:59:09

あなたにオススメの質問