Excel VBA質問箱 IV

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

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


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

【77522】コメントサイズの自動調整エラー くまさん 15/10/19(月) 15:14 質問[未読]
【77524】Re:コメントサイズの自動調整エラー ウッシ 15/10/19(月) 16:13 回答[未読]
【77525】Re:コメントサイズの自動調整エラー くまさん 15/10/19(月) 17:08 発言[未読]
【77526】Re:コメントサイズの自動調整エラー ウッシ 15/10/19(月) 17:12 回答[未読]
【77527】Re:コメントサイズの自動調整エラー くまさん 15/10/19(月) 17:41 発言[未読]
【77528】Re:コメントサイズの自動調整エラー β 15/10/19(月) 21:48 発言[未読]
【77532】Re:コメントサイズの自動調整エラー くまさん 15/10/20(火) 9:11 発言[未読]
【77534】Re:コメントサイズの自動調整エラー β 15/10/20(火) 9:57 発言[未読]
【77535】Re:コメントサイズの自動調整エラー β 15/10/20(火) 10:04 発言[未読]
【77537】Re:コメントサイズの自動調整エラー くまさん 15/10/20(火) 10:34 発言[未読]
【77561】Re:コメントサイズの自動調整エラー くまさん 15/10/22(木) 16:51 お礼[未読]
【77533】Re:コメントサイズの自動調整エラー くまさん 15/10/20(火) 9:35 発言[未読]
【77536】Re:コメントサイズの自動調整エラー ウッシ 15/10/20(火) 10:18 回答[未読]
【77538】Re:コメントサイズの自動調整エラー くまさん 15/10/20(火) 10:40 発言[未読]
【77539】Re:コメントサイズの自動調整エラー ウッシ 15/10/20(火) 11:03 回答[未読]
【77540】Re:コメントサイズの自動調整エラー くまさん 15/10/20(火) 11:24 発言[未読]
【77541】Re:コメントサイズの自動調整エラー ウッシ 15/10/20(火) 11:29 回答[未読]
【77542】Re:コメントサイズの自動調整エラー くまさん 15/10/20(火) 11:54 発言[未読]
【77543】Re:コメントサイズの自動調整エラー ウッシ 15/10/20(火) 12:05 回答[未読]
【77544】Re:コメントサイズの自動調整エラー くまさん 15/10/20(火) 13:22 発言[未読]
【77545】Re:コメントサイズの自動調整エラー ウッシ 15/10/20(火) 13:58 回答[未読]
【77546】Re:コメントサイズの自動調整エラー くまさん 15/10/20(火) 14:25 発言[未読]
【77547】Re:コメントサイズの自動調整エラー ウッシ 15/10/20(火) 15:31 回答[未読]
【77550】Re:コメントサイズの自動調整エラー くまさん 15/10/21(水) 16:18 発言[未読]
【77551】Re:コメントサイズの自動調整エラー ウッシ 15/10/21(水) 16:48 回答[未読]
【77552】Re:コメントサイズの自動調整エラー くまさん 15/10/21(水) 18:11 発言[未読]
【77553】Re:コメントサイズの自動調整エラー ウッシ 15/10/21(水) 18:45 回答[未読]
【77557】Re:コメントサイズの自動調整エラー くまさん 15/10/22(木) 15:22 お礼[未読]
【77558】Re:コメントサイズの自動調整エラー ウッシ 15/10/22(木) 15:56 回答[未読]
【77560】Re:コメントサイズの自動調整エラー くまさん 15/10/22(木) 16:49 お礼[未読]

【77522】コメントサイズの自動調整エラー
質問  くまさん  - 15/10/19(月) 15:14 -

引用なし
パスワード
   はじめまして、自己流でVBA学習中の者です。
コメントサイズの自動調整(XXX.Comment.Visible = True)でエラーが発生し、自己解決が出来そうにないので、質問させていだきます。使用環境はEXCEL2013です。

内容としては、1つ目のファイルでは製品の売上と出荷履歴の管理、2つ目のファイルには主要な製品の出荷管理をしています。
1つ目のファイルに売上の詳細を記入し印刷を押下すると、このファイルに記述されているVBAが呼び出され以下の動作をします。

1.出荷数をまとめた別のワークシートに、注文が入った製品の出荷量を記載する。
2.そのセルにコメント(客先や出荷数など)を記入する。
3.コメントの枠のサイズを自動的に調整する。

主要な製品の場合、2つ目のファイルが呼び出され、上記VBAが再度実行されます。
問題はこの2つ目のエクセルにコメント記入後、サイズを自動調整した際に起こります。
以下がコメントを記入する部分のコードです。

Sub WComment(xlSheet As Worksheet, WMon As Long, WItem As Long, item() As Object, i As Long)
Dim xlRange As Range
Dim ComTxt As String

’ActiviSheetは1つ目のファイルにある売上詳細を記入したワークシートです。
With ActiveSheet
xlSheetは出荷数をまとめたシートです。WMonは出荷月、WItemは売上製品です。(シートには出荷月・売上製品ごとに出荷数をまとめています。)
Set xlRange = xlSheet.Cells(WMon, WItem)
'xlRangeに既に数字(出荷数)が記入されている場合、加算します。
xlRange = .Range("F" & item(i).Row).Value + xlRange.Value
'ComTxt(コメント内容)はActiveSheet(売上詳細のシート)に記載されている日付、客先、出荷数を記載します。
ComTxt = .Range("B5") & " " & .Range("D5") & " " & .Range("F" & item(i).Row).Value & "PC"
'もし、xlRangeにコメントがない場合は新規でコメントを追加します。
If xlRange.Comment Is Nothing Then
xlRange.AddComment Text:=ComTxt
'すでに、xlRangeにコメントがある場合、現在のコメントを改行し、新しいコメントを追記します。
Else
xlRange.Comment.Text Text:=xlRange.Comment.Text & vbCrLf & ComTxt
End If
'コメント欄のサイズを自動調整します。ここでエラー発生(2回めのみ)。
xlRange.Comment.Shape.TextFrame.AutoSize = True
End With
End Sub

エラーメッセージは次のように表示されます。
”アプリケーション定義またはオブジェクト定義のエラーです。”

1つ目のファイルに書き込む際はエラーが起きていないので、別のファイルに書き込むのが問題ないのでしょうか?

以上、ご教授よろしくお願いします。

【77524】Re:コメントサイズの自動調整エラー
回答  ウッシ  - 15/10/19(月) 16:13 -

引用なし
パスワード
   こんにちは

どうしてエラーになるのか分からないのですが、

一旦削除して再セットするとどうなりますか?

    If Not xlRange.Comment Is Nothing Then
      ComTxt = xlRange.Comment.Text & vbCrLf & ComTxt
    End If
    On Error Resume Next
    xlRange.Comment.Delete
    On Error GoTo 0
    
    xlRange.AddComment Text:=ComTxt
    'コメント欄のサイズを自動調整します。ここでエラー発生(2回めのみ)。
    xlRange.Comment.Shape.TextFrame.AutoSize = True

原因はちゃんと究明した方がいいですけど・・・

【77525】Re:コメントサイズの自動調整エラー
発言  くまさん  - 15/10/19(月) 17:08 -

引用なし
パスワード
   ▼ウッシ さん:
早速のご回答ありがとうございます。
記述頂いたコードで実行してみましたが、やはり同じ箇所でエラーが起こります。

Set xlRange = xlSheet.Cells(WItem, WMon)でxlRangeにセットした時点でウォッチウインドウのCommnet.Shape.TextFrame.AutoSizeの欄が”アプリケーション定義または〜"と表示されています。
もし2つ目のファイル呼び出し箇所等、必要なものがあれば追記致しますので、よろしくお願いします。


>こんにちは
>
>どうしてエラーになるのか分からないのですが、
>
>一旦削除して再セットするとどうなりますか?
>
>    If Not xlRange.Comment Is Nothing Then
>      ComTxt = xlRange.Comment.Text & vbCrLf & ComTxt
>    End If
>    On Error Resume Next
>    xlRange.Comment.Delete
>    On Error GoTo 0
>    
>    xlRange.AddComment Text:=ComTxt
>    'コメント欄のサイズを自動調整します。ここでエラー発生(2回めのみ)。
>    xlRange.Comment.Shape.TextFrame.AutoSize = True
>
>原因はちゃんと究明した方がいいですけど・・・

【77526】Re:コメントサイズの自動調整エラー
回答  ウッシ  - 15/10/19(月) 17:12 -

引用なし
パスワード
   こんにちは

WCommentを呼び出す際の引数が間違っているのでは?

xlSheetの内容、WItem、 WMonの値を確認して下さい。

【77527】Re:コメントサイズの自動調整エラー
発言  くまさん  - 15/10/19(月) 17:41 -

引用なし
パスワード
   ▼ウッシ さん:
ご回答ありがとうございます。
引数について確認いたしましたが、いづれも1回目のコメント書き込みと同様のデータ型を使用しているので、問題ないように思われるのですが。
xlSheetにはWorksheet、WMon,WItemには数値


Sub Standard(mon As String, item() As Object, i As Long)
  Dim xlSheet As Worksheet
  Dim objx As Object
  Dim objy As Object
  Dim WMon As Long
  Dim WItem As Long
  
'エクセルをすでに開いているかの確認。
  If IsBookOpen("主要な製品在庫.xlsx") = False Then
    Workbooks.Open Filename:="C:\Users\User\Dropbox\主要な製品在庫.xlsx"
  End If

'ここでxlSheetにセットしています。
    Set xlSheet = Workbooks("主要な製品在庫.xlsx").Worksheets("標準品在庫")
'objxにコメントを書き込むX軸(売上月)の位置を検索します。
    Set objx = xlSheet.Cells.Find(mon & "月", SearchOrder:=xlByRows, LookAt:=xlWhole)
'objyにコメントを書き込むY軸(製品)の位置を検索します。
    Set objy = xlSheet.Cells.Find(item(i), SearchOrder:=xlByColumns, LookAt:=xlWhole)
’主要な製品ではければ、Subを抜けます。
    If objy Is Nothing Then
      Exit Sub
    End If
'WMonにコメントの書き込み列を、WItemに行をいれます。
    WMon = objx.Column + 1
    WItem = objy.Row
'コメント書き込みのプロージャーを呼び出します。
    Call WComment(xlSheet, WItem, WMon, item(), i)

End Sub


>こんにちは
>
>WCommentを呼び出す際の引数が間違っているのでは?
>
>xlSheetの内容、WItem、 WMonの値を確認して下さい。

【77528】Re:コメントサイズの自動調整エラー
発言  β  - 15/10/19(月) 21:48 -

引用なし
パスワード
   ▼くまさん さん:

本筋には関係ないかもしれませんが、

item() って、どんなオブジェクトですか?

【77532】Re:コメントサイズの自動調整エラー
発言  くまさん  - 15/10/20(火) 9:11 -

引用なし
パスワード
   ▼β さん:
ご記入ありがとうございます。
item()には出荷された製品の製品コードが入ります。
1つ目のファイルに記載されている売上情報の中から製品コードを抜き出し、それをクエリに出荷履歴をまとめたシートで出荷数量を記載すべき行を検索します。
売上情報を記載しているシートは1オーダー毎に作成しているため、最大4製品が1シート上に記載されます。


>▼くまさん さん:
>
>本筋には関係ないかもしれませんが、
>
>item() って、どんなオブジェクトですか?

【77533】Re:コメントサイズの自動調整エラー
発言  くまさん  - 15/10/20(火) 9:35 -

引用なし
パスワード
   念のため印刷を押下した際に実行される最初のコードも記載します。独学で作成したので、読みづらいところも多々あると思いますが、よろしくお願いします。

1つ目のファイルには
 ワークシート1には製品の出荷履歴(X軸には納入月、Y軸には製品コード)
 ワークシート2以降はオーダー毎の受注明細が記載されています。
2つ目のファイルには
 ワークシート1には発注履歴(今回は関係なし)
 ワークシート2には主要な製品の在庫表(入出庫履歴)(X軸には納入月、Y軸には製品コード)が記載されています。


Private Sub Workbook_BeforePrint(Cancel As Boolean)
  Dim xlSheet As Worksheet
  Dim yer As String
  Dim mon As String
  Dim item(4) As Object
  Dim i As Long
  i = 1
  Dim objx As Object
  Dim objy As Object
  Dim WMon As Long
  Dim WItem As Long
  
  ActiveSheet.PageSetup.BlackAndWhite = True

'受注明細を記載したシートのタブの色が赤の時のみ実行されるようにしています。
  If ActiveSheet.Tab.ColorIndex = 3 Then
'xlSheetには1つ目のファイルの出荷履歴のシートがセットされます。
    Set xlSheet = ThisWorkbook.Worksheets("商品マスター")
    With ActiveSheet
'yerには受注明細シートに記載されている納入年を、monには納入月が代入されます。それらの変数を使用し、出荷数を記入すべき出荷履歴シートのX軸を検索します。
      yer = Year(.Range("B5"))
      mon = Month(.Range("B5"))
      Set objx = xlSheet.Cells.Find(What:=DateValue(yer & "/" & mon & "/1"), SearchOrder:=xlByRows, LookIn:=xlFormulas)
'itemには製品コードが入ります。受注明細には最大4製品の売上まで1つのシートに記入できるので、item(4)まで有ります。それらの変数を使用し、出荷数を記入すべき出荷履歴シートのY軸を検索します。
      Set item(1) = .Range("B9")
      Set item(2) = .Range("B14")
      Set item(3) = .Range("B19")
      Set item(4) = .Range("B24")
      Do Until item(i) = ""
        Set objy = xlSheet.Cells.Find(What:=item(i), SearchOrder:=xlByColumns)
'検索されたX軸、Y軸の行、列の情報をそれぞれWMonとWItemに代入します。
        WMon = objx.Column
        WItem = objy.Row
'コメント記入のプロージャーを呼び出します。
        Call WComment(xlSheet, WItem, WMon, item(), i)
'2つ目のファイルに記入するプロージャーを呼び出します
        Call Standard(mon, item(), i)
        
        i = i + 1
      Loop
'受注明細に印刷日時を記入し、タブの色をオレンジに変更します。   
    .Range("I2") = Date
    .Tab.ColorIndex = 7
    End With
    ThisWorkbook.Activate
  End If
End Sub

【77534】Re:コメントサイズの自動調整エラー
発言  β  - 15/10/20(火) 9:57 -

引用なし
パスワード
   ▼くまさん さん:

>item()には出荷された製品の製品コードが入ります。

情報の内容ではなく、 As Object と規定していますので、そのオブジェクトというのが
具体的に何なんだろう?というのが質問の意図です。

DIctionary なのか、あるいは?
item() と配列指定にしてありますので、どんなオブジェクトなのかなと。

こちらで、再現させてみようとしても、このオブジェクトが何者かがわからないので
引数に与えることができず、再現テストができないので質問しました。

【77535】Re:コメントサイズの自動調整エラー
発言  β  - 15/10/20(火) 10:04 -

引用なし
パスワード
   ▼くまさん さん:

ついでに申し上げますと、item() の正体がわからなかったので
Sub WComment(xlSheet As Worksheet, WMon As Long, WItem As Long)
と変更し、プロシジャ内で、item と i を 参照しているコードも

xlRange = xlRange.Value
ComTxt = .Range("B5") & " " & .Range("D5") & " " & "PC"

このように変更して実行してみましたが、何度やってもエラーにはなりません。

もっとも xlRange や .Range("B5") や .Range("D5") に実際にはどんな値が入っているのかもわからないんですが。

【77536】Re:コメントサイズの自動調整エラー
回答  ウッシ  - 15/10/20(火) 10:18 -

引用なし
パスワード
   こんにちは

最初の質問で「item(i).Row」となっていたのでセルをSetしているのだろうと
想像は付きましたけど、こちらでもエラーは再現出来ませんでした。

Set objy = xlSheet.Cells.Find(What:=item(i), SearchOrder:=xlByColumns)

で検索結果が無いのでは?

【77537】Re:コメントサイズの自動調整エラー
発言  くまさん  - 15/10/20(火) 10:34 -

引用なし
パスワード
   ▼β さん:
コメントありがとうございます。前の書き込みの分と合わせて回答させていただきます。
item()にはセルを代入しています。そのセルの位置を利用して売上詳細から出荷数量を出しています。
Sub WComment内の下記箇所。ただし、あとになってみれば、わざわざObjectにする必要はなかったかもしれません。
xlRange.Value = .Range("F" & item(i).Row).Value + xlRange.Value
ComTxt = .Range("B5") & " " & .Range("D5") & " " & .Range("F" & item(i).Row).Value & "PC"

xlRangeには出荷数量を書き込むセル、B5、D5には製品の納入日と客先名が入っています。
手探りで記述しているため、おかしいコードの書き方をしているかもしれません。


>▼くまさん さん:
>
>ついでに申し上げますと、item() の正体がわからなかったので
>Sub WComment(xlSheet As Worksheet, WMon As Long, WItem As Long)
>と変更し、プロシジャ内で、item と i を 参照しているコードも
>
>xlRange = xlRange.Value
>ComTxt = .Range("B5") & " " & .Range("D5") & " " & "PC"
>
>このように変更して実行してみましたが、何度やってもエラーにはなりません。
>
>もっとも xlRange や .Range("B5") や .Range("D5") に実際にはどんな値が入っているのかもわからないんですが。

【77538】Re:コメントサイズの自動調整エラー
発言  くまさん  - 15/10/20(火) 10:40 -

引用なし
パスワード
   ▼ウッシ さん:
独学初心者の読みづらいVBAに付き合って頂きありがとうございます。

記入頂いた箇所を確認いたしましたが、やはりobjyには製品コードがセットされていました。1つ目のファイルに書き込む際も、2つ目のファイルに書き込む際もセットできています。


>こんにちは
>
>最初の質問で「item(i).Row」となっていたのでセルをSetしているのだろうと
>想像は付きましたけど、こちらでもエラーは再現出来ませんでした。
>
>Set objy = xlSheet.Cells.Find(What:=item(i), SearchOrder:=xlByColumns)
>
>で検索結果が無いのでは?

【77539】Re:コメントサイズの自動調整エラー
回答  ウッシ  - 15/10/20(火) 11:03 -

引用なし
パスワード
   こんにちは

'コメント欄のサイズを自動調整します。ここでエラー発生(2回めのみ)。
xlRange.Comment.Shape.TextFrame.AutoSize = True

の前に、Application.GoTo xlRange, True
と入れて実行して、該当のセルがアクティブになるか確認して下さい。

【77540】Re:コメントサイズの自動調整エラー
発言  くまさん  - 15/10/20(火) 11:24 -

引用なし
パスワード
   ▼ウッシ さん:
アドバイスありがとうございます。
早速試したところ、
1つ目のファイル(Thisworkbook)に書き込む際は、該当のセルがアクティブになりましたが、2つ目のファイルに書き込む際はアクティブになっていませんでした。

>こんにちは
>
>'コメント欄のサイズを自動調整します。ここでエラー発生(2回めのみ)。
>xlRange.Comment.Shape.TextFrame.AutoSize = True
>
>の前に、Application.GoTo xlRange, True
>と入れて実行して、該当のセルがアクティブになるか確認して下さい。

【77541】Re:コメントサイズの自動調整エラー
回答  ウッシ  - 15/10/20(火) 11:29 -

引用なし
パスワード
   こんにちは

xlRangeに何がセットされるのかステップ実行で確認して下さい。

【77542】Re:コメントサイズの自動調整エラー
発言  くまさん  - 15/10/20(火) 11:54 -

引用なし
パスワード
   ▼ウッシ さん:
すいませんが、どの部分を確認すればよいか教えて頂けますでしょうか?

【77543】Re:コメントサイズの自動調整エラー
回答  ウッシ  - 15/10/20(火) 12:05 -

引用なし
パスワード
   こんにちは

Set xlSheet = ThisWorkbook.Worksheets("商品マスター")

マクロがセットされたブックの「商品マスター」シートで良いのか?

    With ActiveSheet
      yer = Year(.Range("B5"))
      mon = Month(.Range("B5"))

アクティブシートは意図したシートなのか?

年月はそのシートのセルB5から取得でいいのか?

  Set objx = xlSheet.Cells.Find(What:=DateValue(yer & "/" & mon & "/1"), SearchOrder:=xlByRows, LookIn:=xlFormulas)

商品マスタシート上の意図したセル(該当年月初日)が検索されているか
チェックする。

itemにはアクティブシートのセルB9等がセットされているか。

Set objy = xlSheet.Cells.Find(What:=item(i), SearchOrder:=xlByColumns)

で、商品マスタシート上の意図したセル(製品コード)が検索されているか
チェックする。

上記の内容が正しければ、

'コメント記入のプロージャーを呼び出します。
        Call WComment(xlSheet, WItem, WMon, item(), i)

に、正しい引数がセットされるはずです。

【77544】Re:コメントサイズの自動調整エラー
発言  くまさん  - 15/10/20(火) 13:22 -

引用なし
パスワード
   ▼ウッシ さん:

丁寧なご説明ありがとうございます。
確認いたしましたところ、1つ目・2つ目のファイル書き込み時共に下記変数には適切な引数が代入されておりました。
xlSheet, WItem, WMon, item(i)

xlSheet
1回目書き込み時 : "商品マスター"(正しいシート名)
2回目書き込み時 : "標準品在庫"(正しいシート名)

WItem, WMon
1回目書き込み時 : "4", "51"(正しい行と列)
2回目書き込み時 : "8", "13"(正しい行と列)

item(i)
1回目・2回目書き込み時とも同じ正しい製品コード

以上、よろしくお願いします。

【77545】Re:コメントサイズの自動調整エラー
回答  ウッシ  - 15/10/20(火) 13:58 -

引用なし
パスワード
   こんにちは

1つ目・2つ目のファイル書き込み時とはどこで行っている処理なのですか?

Private Sub Workbook_BeforePrint(Cancel As Boolean)
には、1つ目のファイル
Set xlSheet = ThisWorkbook.Worksheets("商品マスター")
のコードしか無いですよね?


Sub Standard(mon As String, item() As Object, i As Long)
と、
Private Sub Workbook_BeforePrint(Cancel As Boolean)
の関連はどうなっていますか?

【77546】Re:コメントサイズの自動調整エラー
発言  くまさん  - 15/10/20(火) 14:25 -

引用なし
パスワード
   ▼ウッシ さん:
レスありがとうございます。

1つ目のファイルはThisWorkbookです。2つ目のファイルは別ファイルです。

Private Subの中で売上明細からyer(売上年)、mon(売上月)、item(製品コード)、WMon&WItem(書き込み行列)を取得して、Sub Wcommentを呼び出し、出荷数とコメント入力を行っています。
その後、Sub Standardを呼び出しPrivate Subの中で取得したmon(売上月)とitem(製品コード)を引数として割り当て、それを元にWMon&WItem(書き込み行列)を取得します。
主要な製品ではないものは下記コードでSub Standardを抜けるようになっているので、書き込みされません。
Set objy = xlSheet.Cells.Find(item(i), SearchOrder:=xlByColumns, LookAt:=xlWhole)
If objy Is Nothing Then
  Exit Sub
End If

【77547】Re:コメントサイズの自動調整エラー
回答  ウッシ  - 15/10/20(火) 15:31 -

引用なし
パスワード
   こんにちは

Sub WComment(xlSheet As Worksheet, WMon As Long, WItem As Long, item() As Object, i As Long)
  Dim xlRange As Range
  Dim ComTxt As String
  
  'ActiviSheetは1つ目のファイルにある売上詳細を記入したワークシートです。
  With ActiveSheet
    'xlSheetは出荷数をまとめたシートです。WMonは出荷月、WItemは売上製品です。(シートには出荷月・売上製品ごとに出荷数をまとめています。)
    Set xlRange = xlSheet.Cells(WMon, WItem)
    'xlRangeに既に数字(出荷数)が記入されている場合、加算します。
    MsgBox "xlRangeのアドレスは-----" & xlRange.Address(0, 0, xlA1, True)
    MsgBox "加算セルのアドレスは-----" & .Range("F" & item(i).Row).Address(0, 0, xlA1, True)
    xlRange = .Range("F" & item(i).Row).Value + xlRange.Value

として、それぞれのセルのアドレスが正しいか確認して下さい。

また、全体的にコードを見直して、ActiveSheetという部分を

ThisWorkbook.Worksheets("受注明細シート")
とか、
Workbooks("主要な製品在庫.xlsx").Worksheets("標準品在庫")
のように、

実際にActiveSheetであって欲しいシートを指定するようにしてみて下さい。

【77550】Re:コメントサイズの自動調整エラー
発言  くまさん  - 15/10/21(水) 16:18 -

引用なし
パスワード
   ▼ウッシ さん:
毎度丁寧にアドレスいいただきありがとうございます。
最初の行でActiveSheetをPrtSheetというワークシートオブジェクトに代入し、以降使用を止めました。
その上で書き込んで頂いたコードを試しましたが、xlRangeのアドレス、加算セルのアドレス共に意図した通りのアドレスが表示されることを確認いたしました。

念のため書き直したコード全てを下記に記載します。


  Dim PrtSheet As Worksheet
Private Sub Workbook_BeforePrint(Cancel As Boolean)
  Dim xlSheet As Worksheet
  Dim yer As String
  Dim mon As String
  Dim item(4) As Object
  Dim i As Long
  i = 1
  Dim objx As Object
  Dim objy As Object
  Dim WMon As Long
  Dim WItem As Long
  
'PrtSheetには受注明細を記載したシートがセットされます。
  Set PrtSheet = ActiveSheet
  PrtSheet.PageSetup.BlackAndWhite = True

'受注明細を記載したシートのタブの色が赤の時のみ実行されるようにしています。
  If PrtSheet.Tab.ColorIndex = 3 Then
'xlSheetには1つ目のファイルの出荷履歴のシートがセットされます。
    Set xlSheet = ThisWorkbook.Worksheets("商品マスター")
    With PrtSheet
'yerには受注明細シートに記載されている納入年を、monには納入月が代入されます。それらの変数を使用し、出荷数を記入すべき出荷履歴シートのX軸を検索します。
      yer = Year(.Range("B5"))
      mon = Month(.Range("B5"))
      Set objx = xlSheet.Cells.Find(What:=DateValue(yer & "/" & mon & "/1"), SearchOrder:=xlByRows, LookIn:=xlFormulas)
'itemには製品コードが入ります。受注明細には最大4製品の売上まで1つのシートに記入できるので、item(4)まで有ります。それらの変数を使用し、出荷数を記入すべき出荷履歴シートのY軸を検索します。
      Set item(1) = .Range("B9")
      Set item(2) = .Range("B14")
      Set item(3) = .Range("B19")
      Set item(4) = .Range("B24")
      Do Until item(i) = ""
        Set objy = xlSheet.Cells.Find(What:=item(i), SearchOrder:=xlByColumns)
'検索されたX軸、Y軸の行、列の情報をそれぞれWMonとWItemに代入します
        WMon = objx.Column
        WItem = objy.Row
'出荷数量、コメント書き込みのプロージャーを呼び出します。
        Call WComment(xlSheet, WItem, WMon, item(), i)
'2つ目のファイルに記入するプロージャーを呼び出します
        Call Standard(mon, item(), i)
        
        i = i + 1
      Loop
'受注明細に印刷日時を記入し、タブの色をオレンジに変更します。
    .Range("I2") = Date
    .Tab.ColorIndex = 7
    End With
    ThisWorkbook.Activate
  End If
End Sub

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

Sub Standard(mon As String, item() As Object, i As Long)
  Dim xlSheet As Worksheet
  Dim objx As Object
  Dim objy As Object
  Dim WMon As Long
  Dim WItem As Long
  
'Function IsBookOpenを使用し、既にファイルが開いているかを確認し、ファイルを開きます。
  If IsBookOpen("RFMラドル出荷状況一覧.xlsx") = False Then
    Workbooks.Open Filename:="C:\Users\Yusuke Kumano\Dropbox\RFMラドル出荷状況一覧.xlsx"
  End If
  
  With PrtSheet
'xlSheetに主要な製品の在庫数を記載したシートをセットします。
    Set xlSheet = Workbooks("RFMラドル出荷状況一覧.xlsx").Worksheets("標準品在庫")
'objxにコメントを書き込むX軸(売上月)の位置を検索します。
'objyにコメントを書き込むY軸(製品)の位置を検索します。
    Set objx = xlSheet.Cells.Find(mon & "月", SearchOrder:=xlByRows, LookAt:=xlWhole)
    Set objy = xlSheet.Cells.Find(item(i), SearchOrder:=xlByColumns, LookAt:=xlWhole)
'主要な製品ではければ、Subを抜けます。
    If objy Is Nothing Then
      Exit Sub
    End If
'WMonに出荷数量とコメントを書き込む列を、WItemに行をいれます。
    WMon = objx.Column + 1
    WItem = objy.Row
'出荷数量、コメント書き込みのプロージャーを再度呼び出します。
    Call WComment(xlSheet, WItem, WMon, item(), i)
    
  End With
End Sub

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

Function IsBookOpen(strBookName As String) As Boolean
  Dim objBook As Workbook

  IsBookOpen = False

  For Each objBook In Workbooks
    If objBook.Name = strBookName Then
      IsBookOpen = True
    Exit For
  End If
  Next
End Function

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

Sub WComment(xlSheet As Worksheet, WItem As Long, WMon As Long, item() As Object, i As Long)
  Dim xlRange As Range
  Dim ComTxt As String

'PrtSheetは1つ目のファイルにある売上詳細を記入したワークシートです。
  With PrtSheet
'xlSheetは出荷履歴(在庫数)をまとめたシートがセットされています。WMonは出荷月、WItemは売上製品です。
    Set xlRange = xlSheet.Cells(WItem, WMon)
    MsgBox "xlRangeのアドレスは-----" & xlRange.Address(0, 0, xlA1, True)
    MsgBox "加算セルのアドレスは-----" & .Range("F" & item(i).Row).Address(0, 0, xlA1, True)
'xlRangeに既に数字(出荷数)が記入されている場合、加算します。
    xlRange.Value = .Range("F" & item(i).Row).Value + xlRange.Value
'ComTxt(コメント内容)はPrtSheet(売上明細シート)に記載されている日付:.Range("D5")、客先:.Range("D5")、出荷数:.Range("F" & item(i).Row)を記載します。
    ComTxt = .Range("B5") & " " & .Range("D5") & " " & .Range("F" & item(i).Row).Value & "PC"
'コメントが既にあるかないかで新規記入か追記かを判断しています。
    If xlRange.Comment Is Nothing Then
      xlRange.AddComment Text:=ComTxt
    Else
      xlRange.Comment.Text Text:=xlRange.Comment.Text & vbCrLf & ComTxt
    End If
'コメント欄のサイズを自動調整します。ここでエラー発生(2回めのみ)。
    xlRange.Comment.Shape.TextFrame.AutoSize = True
  End With
End Sub


以上、よろしくお願いします。

【77551】Re:コメントサイズの自動調整エラー
回答  ウッシ  - 15/10/21(水) 16:48 -

引用なし
パスワード
   こんにちは

コード綺麗になってきましたね。
後はインデント揃えると見易くなりますね。

と言っても、エラーの原因は分かりません・・・

無駄な処理ですけど、一旦内容クリアしてセットしなおしてから
コメント欄のサイズを自動調整するとどうなりますか?

'コメントが既にあるかないかで新規記入か追記かを判断しています。
    If xlRange.Comment Is Nothing Then
      xlRange.AddComment Text:=ComTxt
    Else
      If ComTxt = "" Then
        ComTxt = xlRange.Comment.Text
      Else
        ComTxt = xlRange.Comment.Text & vbCrLf & ComTxt
      End If
      xlRange.Comment.Text Text:=""
      xlRange.Comment.Shape.TextFrame.AutoSize = False
      xlRange.Comment.Text Text:=ComTxt
    End If
'コメント欄のサイズを自動調整します。ここでエラー発生(2回めのみ)。
    xlRange.Comment.Shape.TextFrame.AutoSize = True

【77552】Re:コメントサイズの自動調整エラー
発言  くまさん  - 15/10/21(水) 18:11 -

引用なし
パスワード
   ▼ウッシ さん:
ありがとうございます。読みやすいコードが書けるように努力します。

早速記述頂いたコードで実行してみましたが、2回目(主要な製品の在庫シートへの)のコメント書き込み時にエラーが起こりました。エラーの箇所は下記の追加した部分です。

xlRange.Comment.Shape.TextFrame.AutoSize = False

エラーの内容はTrueに書き換える際に出ていたのと同じエラーでした。”実行時エラー'1004': アプリケーション定義またはオブジェクト定義のエラーです。”

【77553】Re:コメントサイズの自動調整エラー
回答  ウッシ  - 15/10/21(水) 18:45 -

引用なし
パスワード
   こんばんは

そのエラーは存在しないシートやセルやオブジェクトに対する処理で起きていると考えられます。

無関係だとは思いますが参照設定に参照不可の項目は無いですか?

ちょっと他に思い付かないのですが、コメントを設定するブックを新規に作り直してテストしてみてどうなるか試してみて下さい。

【77557】Re:コメントサイズの自動調整エラー
お礼  くまさん  - 15/10/22(木) 15:22 -

引用なし
パスワード
   ▼ウッシ さん:
こんにちは。
コメントを設定するブックを新規に作りなおしたところ、なんと解決いたしました。
過去にxlsからxlsxに変換したのが影響していたのでしょうか・・・

結局原因のわからないままでしたが、長いことお付き合いいただきまして本当にありがとうございました。不具合としては大したことありませんでしたが、ずっと気になってはいたのでスッキリしました。

【77558】Re:コメントサイズの自動調整エラー
回答  ウッシ  - 15/10/22(木) 15:56 -

引用なし
パスワード
   こんにちは

こちらでエラーが再現出来ない時点でブックを再作成して貰った方がいい
とは思ってたのですが・・・・

でも、コードも大分整理されましたし良かったですね。

【77560】Re:コメントサイズの自動調整エラー
お礼  くまさん  - 15/10/22(木) 16:49 -

引用なし
パスワード
   ▼ウッシ さん:
すいません、ブックを再作成するという考えが思いつきませんでした。
しかし、お陰様で色々勉強になりました。ありがとうございました。

【77561】Re:コメントサイズの自動調整エラー
お礼  くまさん  - 15/10/22(木) 16:51 -

引用なし
パスワード
   ▼β さん:
以前にコメント頂いていた件、結局コメントを書き込むブックを再作成したところ、現象は収まりました。
色々アドバイスしていただき、ありがとうございました。


>▼くまさん さん:
>
>ついでに申し上げますと、item() の正体がわからなかったので
>Sub WComment(xlSheet As Worksheet, WMon As Long, WItem As Long)
>と変更し、プロシジャ内で、item と i を 参照しているコードも
>
>xlRange = xlRange.Value
>ComTxt = .Range("B5") & " " & .Range("D5") & " " & "PC"
>
>このように変更して実行してみましたが、何度やってもエラーにはなりません。
>
>もっとも xlRange や .Range("B5") や .Range("D5") に実際にはどんな値が入っているのかもわからないんですが。

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