Excel VBA質問箱 IV

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

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


4801 / 76735 ←次へ | 前へ→

【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


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

0 hits

【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 お礼[未読]

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