Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10全般 : Excel 2019)
VBA CopyPictureについて
投稿日時: 22/05/24 15:02:15
投稿者: nexfinity0215

こんにちは、VBAのCopyPictureについて質問です。
CopyPictureは、サイズの指定とかできないのでしょうか?
下記のコードで、Outlookへ別々のシートのセル内容を画像として貼り付けを3枚行いたいのですが、横幅を(258mm)縦幅(自動)にしたいのですが、やはり難しいのでしょうか?
皆様のお力をお借りできたらと思います。どうぞよろしくお願いいたします。
 
Sub test12()
 Set myoutlook = CreateObject("outlook.application")
 Set mail = myoutlook.CreateItem(O)
 
With mail
 .To = ThisWorkbook.Worksheets(4).Cells(7, 2)
 '.CC = ThisWorkbook.Worksheets(4).Cells(7, 2)
 '.Attachments.Add UploadFile
 .subject = Replace(ThisWorkbook.Worksheets(4).Cells(2, 2).Value, "{日付}", Date)
 .Display
With mail.GetInspector.WordEditor.Windows(1).Selection
 Body1 = ThisWorkbook.Worksheets(4).Cells(3, 2)
 .Font.Name = "Calibri"
 .Font.Size = "11"
 TypeText = Body1
 .TypeText Chr(13)
 Worksheets(2).Range("A1:O25").CopyPicture
 .Paste
 Worksheets(3).Range("A1:O25").CopyPicture
 .Paste
 Worksheets(1).Range("A1:N41").CopyPicture
 .Paste
End With
 Application.CutCopyMode = False
End With
End Sub

回答
投稿日時: 22/05/24 15:34:22
投稿者: taitani

以下を参照してみましょう。
https://officevba.info/copypicture/

投稿日時: 22/05/24 15:41:13
投稿者: nexfinity0215

ご返信ありがとうございます。
Set Shp = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
’位置とサイズを適当に合わせる
Shp.Width = Shp.Width / 2
Shp.Top = Shp.Top + 10
Set Shp = Nothing
こちらをどこにいれたらいいですか…?
探りで入れたら、セルにある図形1つだけが小さくなりました…

回答
投稿日時: 22/05/24 16:37:36
投稿者: taitani

VBA の Code を見て、どの行で何を行っているか理解されていますでしょうか。
理解できれば、自ずと、どこに、どのように追加を行えばよいか見えてくるはずです。

回答
投稿日時: 22/05/24 18:11:18
投稿者: sk

引用:
Outlookへ別々のシートのセル内容を画像として貼り付けを3枚行いたい

引用:
横幅を(258mm)縦幅(自動)にしたい

(標準モジュール)
--------------------------------------------------------------------
Sub test12()
   
    Set MyOutlook = CreateObject("Outlook.Application")
    Set MyMailItem = MyOutlook.CreateItem(0)
     
    With MyMailItem
        .To = ThisWorkbook.Worksheets(4).Cells(7, 2)
        .Subject = Replace(ThisWorkbook.Worksheets(4).Cells(2, 2).Value, "{日付}", Date)
        .BodyFormat = 1 'olFormatPlain
        .Body = ""
        .BodyFormat = 2 'olFormatHTML
        .Display
        Set WordDoc = .GetInspector.WordEditor
        Set WordApp = WordDoc.Application
    End With
         
    With WordDoc
         
        With .Paragraphs(1).Range
            .Font.Name = "Calibri"
            .Font.Size = "11"
            Body1 = ThisWorkbook.Worksheets(4).Cells(3, 2)
            .Collapse 0 'wdCollapseEnd
            .Text = Body1
        End With
         
        Worksheets(2).Range("A1:O25").CopyPicture
        With .Paragraphs.Add.Range
            .Collapse 0 'wdCollapseEnd
            .Paste
        End With
        Set WordInlineShape = .InlineShapes(.InlineShapes.Count)
        With WordInlineShape
            .LockAspectRatio = True
            .Width = WordApp.CentimetersToPoints(5)
        End With
        Set WordInlineShape = Nothing
         
        Worksheets(3).Range("A1:O25").CopyPicture
        With .Paragraphs.Add.Range
            .Collapse 0 'wdCollapseEnd
            .Paste
        End With
        Set WordInlineShape = .InlineShapes(.InlineShapes.Count)
        With WordInlineShape
            .LockAspectRatio = True
            .Width = WordApp.CentimetersToPoints(10)
        End With
        Set WordInlineShape = Nothing
         
        Worksheets(1).Range("A1:N41").CopyPicture
        With .Paragraphs.Add.Range
            .Collapse 0 'wdCollapseEnd
            .Paste
        End With
        Set WordInlineShape = .InlineShapes(.InlineShapes.Count)
        With WordInlineShape
            .LockAspectRatio = True
            .Width = WordApp.CentimetersToPoints(15)
        End With
        Set WordInlineShape = Nothing
         
        Application.CutCopyMode = False
    End With
     
    Set WordDoc = Nothing
    Set WordApp = Nothing
    Set MyMailItem = Nothing
    Set MyOutlook = Nothing
 
End Sub
--------------------------------------------------------------------
 
上記のような処理を実行したい、ということでしょうか。
 
引用:
https://officevba.info/copypicture/

引用:
Set Shp = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)

参照すべきなのは、Outlook のメッセージの本文に挿入された図形であって、
Excel ワークシート上の図形ではないでしょう。

投稿日時: 22/05/24 19:53:06
投稿者: nexfinity0215

ありがとうございます!!おっしゃる通りです!
ご丁寧にありがとうございます!とても参考になりました!