[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『Outlookメール本文にExcelの表を貼り付ける方法』(dokom)
【新規】の後に貼り付けた後に【変更】の後に貼り付けしたいです。
お分かりになる方教えていただけますでしょうか。
Sub CreatePivotTable()
Application.DisplayAlerts = False
Dim ws As Worksheet
For Each ws In Worksheets If ws.Name = "当日件数" Then ws.Delete End If Next ws
Application.DisplayAlerts = True
'プログラム2|シート設定 Set ws = Worksheets("選任マスタ(Y)")
'プログラム3|ピボットキャッシュを生成 Dim pc As PivotCache Set pc = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=ws.Range("A1").CurrentRegion.Address)
'プログラム4|ピボットテーブルを作成 Dim pt As PivotTable Set pt = pc.CreatePivotTable(tabledestination:=Sheets.Add.Range("A1"), TableName:="pivot1")
'プログラム5|ピボットテーブルのフィールド設定 With pt
'プログラム6|行フィールドを設定 With .PivotFields("BU") .Orientation = xlRowField End With
'プログラム7|列フィールドを設定 .PivotFields("売上区分名").Orientation = xlColumnField
'プログラム8|値フィールドを設定 .PivotFields("新規追加日").Orientation = xlDataField
'プログラム9|行フィールドを設定 With .PivotFields("新規追加日") .Orientation = xlPageField End With
'プログラム10|行フィールドを設定 With .PivotFields("20年度売上完了、連絡用") .Orientation = xlPageField End With End With
'プログラム11|ピボットテーブルの表示形式を変更 With pt .RowAxisLayout xlTabularRow .ColumnGrand = False .RowGrand = False .HasAutoFormat = False .RepeatAllLabels xlRepeatLabels .NullString = 0 End With
With ActiveSheet.PivotTables("pivot1") .DisplayErrorString = True .NullString = "" End With
ActiveSheet.PivotTables("pivot1").HasAutoFormat = True
Dim itm As PivotItem, itm2 As PivotItem, buf As String Set ws = Sheets("当日件数") buf = Format(Date, "m/d/yyyy")
For Each itm In ws.PivotTables("pivot1") _ .PivotFields("新規追加日").PivotItems Select Case itm.Value Case buf itm.Visible = True Case Else itm.Visible = False End Select Next itm ’---------------------------------------------------------- MaxRow = ws.Cells(Rows.Count, 1).End(xlUp).Row MaxCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column ws.Range(Cells(4, 1), Cells(MaxRow, MaxCol)).Copy ★コピーした範囲をメールの【新規】の後に貼り付けしたい ’---------------------------------------------------------- Dim itm2 As PivotItem For Each itm2 In ws.PivotTables("pivot1") _ .PivotFields("変更").PivotItems Select Case itm2.Value Case "追加" itm2.Visible = True Case Else itm2.Visible = False End Select Next itm2 ’---------------------------------------------------------- Maxrow2 = ws.Cells(Rows.Count, 1).End(xlUp).Row MaxCol2 = ws.Cells(1, Columns.Count).End(xlToLeft).Column ws.Range(Cells(4, 1), Cells(Maxrow2, MaxCol2)).Copy ★コピーした範囲をメールの【変更】の後に貼り付けしたい ’----------------------------------------------------------
Dim objOutlook As Outlook.Application Dim objMail As Outlook.MailItem Dim wsMail As Worksheet
Set objOutlook = New Outlook.Application Set wsMail = ThisWorkbook.Sheets("当日件数")
Set objMail = objOutlook.CreateItem(olMailItem)
With wsMail objMail.To = "XXX@aaa.com" objMail.Subject = "Format(Date, "m/d") & "完了" objMail.BodyFormat = olFormatHTML objMail.Body = "各位" & vbCrLf & "お疲れ様です。●●です。" & vbCrLf & vbCrLf _ & "本日新規分完了しました。& vbCrLf & "以下に詳細を追記します。" & vbCrLf & vbCrLf & "【新規】" & vbCrLf & vbCrLf & vbCrLf & "【変更】" & _ vbCrLf & vbCrLf & vbCrLf & "●●" 'メール本文 objMail.Display End With
Set objOutlook = Nothing
End sub
< 使用 Excel:Office365、使用 OS:Windows10 >
# 私見ですが、こうした情報は、添付ファイルで受け渡すほうが、
# 双方にとって有益だとは思います。
(γ) 2021/11/26(金) 21:08
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.