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

締切り済みの質問

ファイル名が原因?Excelのマクロについて質問!

Excelのマクロ初心者です。
1つのフォルダ内の全ファイル(xlsのみ)を対象として、
印刷枚数をカウントし、記録したいと考えています。
ですが、以下のプログラムを実行すると・・・

ファイル名が同じ形式であれば、正しく処理されます。
ですが、ファイル名が日本語・アルファベット・アンダーバーなどの記号などが入り混じって、その数もファイルによってバラバラだと、
印刷枚数のカウントは上手くいくみたいなのですが、
表記が前のファイルのシート名の上に次のファイルのシート名が重なってしまい、上手くいきません。

自分で調べたり、考えたりしたのですが、未だに分かりません。
助けてください。

Sub 現在のフォルダを取得の上、全シートのシート単位の印刷枚数を数える()
Dim myFolder As String '//フォルダパス
Dim myFile As String '//フォルダパス + ファイル名
Dim mySheetNam As String '//シート名
Dim Sh_Co As Integer '//シート数
Dim i As Integer '//カウンタ変数
Dim y As Integer '//カウンタ変数
Dim Sh_Pz As Integer '//印刷枚数(シート単位)
Dim Pr_kz As Integer '//印刷枚数(ファイル単位)
Dim all_Pz As Integer '//総印刷枚数
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
y = 1

'//************** フォルダのパスの取得 ************
myFolder = ThisWorkbook.Path & "\"
'//************** パスの転記 **********************
ThisWorkbook.Sheets(1).Cells(4, 1).Value = myFolder
'//************** ファイル名の取得 ****************
myFile = Dir(myFolder & "**.xls")

'//******* 該当のファイル(エクセルファイル)が存在する限り続ける ******
Do While myFile <> ""
'//**** 現在のブック以外の場合は処理を行う ****
If ThisWorkbook.Name <> myFile Then
'//**** ファイル名の転記****
ThisWorkbook.Sheets(1).Cells(y + 5, 1).Value = myFile
'//**** ブックを開く****
Workbooks.Open myFolder & myFile

'//***********************************************************************
'//**** 開いたブックに対しての処理 ***************************************
'//***********************************************************************
'//*** アクティブなブックのシート数取得 ***
Sh_Co = ActiveWorkbook.Worksheets.Count
'//*** シートの枚数分処理を行う****
For i = 1 To Sh_Co
mySheetNam = Sheets(i).Name
'//**** シート名を転記****
ThisWorkbook.Sheets(1).Cells(y + 5, 2).Value = mySheetNam

ActiveWorkbook.Sheets(i).Select
'//*** 印刷枚数(シート単位)取得 ***
Sh_Pz = Application.ExecuteExcel4Macro("GET.DOCUMENT(50)")
'//印刷枚数(シート単位)の転記****
ThisWorkbook.Sheets(1).Cells(y + 5, 3).Value = Sh_Pz
'//*** 印刷枚数(ブック単位)取得 ***
Pr_kz = Pr_kz + Application.ExecuteExcel4Macro("GET.DOCUMENT(50)")
y = y + 1
Next i
'//****印刷枚数(ブック単位)の転記****
ThisWorkbook.Sheets(1).Cells(y + 5 - Sh_Co, 4).Value = Pr_kz

'//****ファイルを閉じる****
Workbooks(myFile).Close

'//****罫線を引く****
With Range(Cells(y + 5, 1), _
Cells(y + 5, 5)).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Else
'//***現在のブックだった場合の処理(転記のずれを修正する為)***
y = y - 4

End If
'// ****印刷数の累計計算****
all_Pz = all_Pz + Pr_kz
'// ****データの初期化****
Sh_Co = 0
Pr_kz = 0
myFile = Dir()
y = y + 1
Loop 'Do 位置までもどり繰り返す

'// ****総印刷枚数の転記****
ThisWorkbook.Sheets(1).Cells(6, 5).Value = all_Pz

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

投稿日時 - 2009-09-04 14:42:27

QNo.5262145

すぐに回答ほしいです

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

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

回答(3)

ANo.3

回答2、myRangeです。

>今後の勉強のために、なぜこのように直すと上手くいくか教えてほしいです

下記の質問提示のコードで説明します。

>If ThisWorkbook.Name <> myFile Then
>  各シート頁数の計算
>Else
'//***現在のブックだった場合の処理(転記のずれを修正する為)***
>y = y - 4
>End If

これでは、OpenしようとするブックがThisWorkbookだったら、Elseの処理(y=y-4)が実行されますよね。
ところが、ブックがThiwWorkbookであれば、頁数の計算(結果の転記)処理はしないので、変数yは増減しません。
ということは、yに対しては何もしなくていいわけですが、y=y-4と余計なことをしているのでおかしなことになるわけです。
で、この不要な部分は削除することになります。

そして、
>y = y + 1
>Loop 'Do 位置までもどり繰り返す

このy=y+1ですが、この位置では、ブックがThisWorkbookの時(頁計算をしない時)もここを通ることになるので、yが1増えてしまいます。
yの値が増えるのは、ThiwWorkbook以外のブックの頁数を計算しそれをシートに転記するための行を決めるときだけですから、このy=y+1は上部の、End ifの前でなければいけないわけです。
 
長々と書きましたがこんなんで説明になってますでしょうか。
不明な点があれば再質問願います。
以上です。
 

投稿日時 - 2009-09-04 23:50:01

ANo.2

一見しただけですが、
提示のコードはファイル名云々の前に意図する動作はしないと思いますが。。

それとプロシージャの名前が長過ぎませんか?

Sub ブックの印刷枚数を数える()  とか何とかでいいのでは?

それらを踏まえて下記のようにしてください。関係する部分だけです。

  ●は、追加
  ▼は、削除

'-------------------------------------------------------------
'//****罫線を引く****
With Range(Cells(y + 5, 1), _
Cells(y + 5, 5)).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

  y = y + 1  '●追加

  '▼削除  Else
  '▼削除  //***現在のブックだった場合の処理(転記のずれを
  '▼削除  y = y - 4

End If
'// ****印刷数の累計計算****
all_Pz = all_Pz + Pr_kz
'// ****データの初期化****
Sh_Co = 0
Pr_kz = 0
myFile = Dir()

  '▼削除 y = y + 1

Loop 'Do 位置までもどり繰り返す

'---------------------------------------------------------


以上です。

投稿日時 - 2009-09-04 16:04:26

お礼

すみません。
ありがとうございます!!
ご指摘の通りに直したら、上手くいきました。
ですが、今後の勉強のために、なぜこのように直すと上手くいくか教えてほしいです。
お願いします。

投稿日時 - 2009-09-04 16:34:17

ANo.1

途中までしか見てませんが
myFile = Dir(myFolder & "**.xls")
*が2個有るのが気になります

投稿日時 - 2009-09-04 16:02:02

お礼

すみません。
*は普通一つですよね!!
ご指摘ありがとうございます。

投稿日時 - 2009-09-04 16:31:25

あなたにオススメの質問