[[20211101164235]]　『マクロで図形上の日本語フォント変更と図形背景を』（たいたい）　ページの最後に飛ぶ

『マクロで図形上の日本語フォント変更と図形背景を画像で塗りつぶしたい』（たいたい）

2つあります。
１．
図形を作成→図形のテキストのフォントを設定してグループ化するマクロを作りました。

Sub 図形とテキスト()
Worksheets("Sheet1").Select

    With ActiveSheet.Range("b3:e5")
        ActiveSheet.Shapes.AddShape(msoShapeRectangle, .Left, .Top, .Width, .Height).Name = "背景"
    End With

    With ActiveSheet.Range("c4")
        ActiveSheet.Shapes.AddShape(msoShapeRectangle, .Left, .Top, .Width, .Height).Name = "テキスト"
        ActiveSheet.Shapes("テキスト").TextFrame.Characters.Text = "あa1"
        ActiveSheet.Shapes("テキスト").TextFrame.Characters.Font.Size = 12
        ActiveSheet.Shapes("テキスト").TextFrame.Characters.Font.Name = "ＭＳ 明朝"
    End With

    ActiveSheet.Shapes.SelectAll
    Selection.Group.Name = "A"

End Sub

しかし英数はＭＳ明朝に切り替わりましたが日本語が切り替わりません。
セルに対するフォント切り替えは日本語と英数どちらもいけました。
図形で日本語にもフォントの切り替えを適応させるにはどうすればいいでしょうか。

２．
またこの作成した図形の背景を、図の参照で画像を自由に選択したうえで塗りつぶすマクロを作ろうとおもってマクロの記録をしました。

Sub Macro1()
'
' Macro1 Macro
'

    ActiveSheet.Shapes.Range(Array("Rectangle 4")).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .UserPicture _
        "C:\Users\□□□\Pictures\□□□\□□□.jpg"
        .TextureTile = msoFalse
        .RotateWithObject = msoTrue
    End With
End Sub

しかしこれでは最初に指定した画像しか使えません。
図の挿入を挟ませるにはどうすればいいでしょうか。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

 .TextaFrame2.TextRange.Font.NameFarEast で検索してみてください
（´・ω・`） 2021/11/01(月) 17:52

（´・ω・`）さん

ヒントを元に１．の日本語フォントはクリアできました。ありがとうございます。

        ActiveSheet.Shapes.AddShape(msoShapeRectangle, .Left, .Top, .Width, .Height).Name = "テキスト"
        ActiveSheet.Shapes("テキスト").TextFrame.Characters.Text = "あ愛a1"
        ActiveSheet.Shapes("テキスト").TextFrame.Characters.Font.Size = 12
        ActiveSheet.Shapes("テキスト").TextFrame.Characters.Font.Name = "ＭＳ 明朝"
        ActiveSheet.Shapes("テキスト").TextFrame2.TextRange.Font.NameFarEast = "HGP創英角ﾎﾟｯﾌﾟ体"

２．の方は難しいでしょうか。
昨日から検索を色々とかけて、ファイルの開き方と名前で指定した図形の背景色を変えるところまではできました。
しかしこの2つを組み合わせる方法が見つかりません。

Sub 背景の塗りつぶしを画像に変更()

    Dim FileName As Variant
    FileName = Application.GetOpenFilename(FileFilter:="画像ファイル,*.bmp")
    If FileName = False Then
        Exit Sub
    End If
（↑の文を↓に組み込みたい）

    With ActiveSheet.Shapes("背景").Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 192, 0)
        .Transparency = 0
        .Solid
    End With
End Sub

どなたかアドバイスをお願いします。
（たいたい） 2021/11/02(火) 16:48

 Sub 背景の塗りつぶしを画像に変更() 
    Dim FileName As Variant
    FileName = Application.GetOpenFilename(FileFilter:="画像ファイル,*.bmp")
    If FileName = False Then
        Exit Sub
    Else
       With ActiveSheet.Shapes("背景").Fill
           .Visible = msoTrue
           .ForeColor.RGB = RGB(255, 192, 0)
           .Transparency = 0
           .Solid
       End With
    End if
End Sub
違っていたらごめんなさいね。

（TAI） 2021/11/02(火) 18:26

なにがしたいのかイマイチわからないけど

    ActiveSheet.Shapes.Range(Array("Rectangle 4")).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .UserPicture _
        "C:\Users\□□□\Pictures\□□□\□□□.jpg"
        .TextureTile = msoFalse
        .RotateWithObject = msoTrue
    End With
の  .UserPicture に取得した FileName を指定するというはなしなのでわ？
（とおりすがり） 2021/11/02(火) 19:10

言葉が足りなくてごめんなさい。
（とおりすがり）さんの言うとおり、

    ActiveSheet.Shapes.Range(Array("Rectangle 4")).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .UserPicture _
        "C:\Users\□□□\Pictures\□□□\□□□.jpg"
        .TextureTile = msoFalse
        .RotateWithObject = msoTrue
    End With
（実際に選択したい図形はActiveSheet.Shapes("背景")）

に

    Dim FileName As Variant
    FileName = Application.GetOpenFilename(FileFilter:="画像ファイル,*.bmp")
    If FileName = False Then
        Exit Sub
    End If

を組み込みたいです。
2回目の色を変えた奴は、図形の単色塗りつぶしまでは作れたけど、そこからfilenameを使用した図の塗りつぶしにつなげる方法が分からないと言った意味で投稿しました。
（たいたい） 2021/11/04(木) 09:43

再度読み直してだいぶ文章があやふやになっていたのであらためて書き直します。

    With ActiveSheet.Shapes("背景").Fill
        .Visible = msoTrue
        .UserPicture _

/////塗りつぶしのタイミングでこの動きを入れたい/////

    Dim FileName As Variant
    FileName = Application.GetOpenFilename(FileFilter:="画像ファイル,*.jpg")
    If FileName = False Then
        Exit Sub
    End If
///////////////////////////////////////////////////

        .TextureTile = msoFalse
        .RotateWithObject = msoTrue
    End With

画像のファイル名を直接書き込む方法やオートシェイプではなく直接画像を図形化するのは見かけましたが、触りたいのはグループの最背面にある図形になるので、背景画像を変えるたびにグループ解除→図形削除→画像入れ込み→再グループ化して最背面に置く動作よりは塗りつぶし機能で画像を入れ込める方がシンプルではないかと考えてこの方法で模索しています。
アドバイスをお願いいたします。
（たいたい） 2021/11/05(金) 09:23

＞.UserPicture に取得した FileName を指定
そのものずばり書かないとわからないですか。そうですか。

    Dim FileName As Variant
    FileName = Application.GetOpenFilename(FileFilter:="画像ファイル,*.jpg")
    If FileName = False Then
        Exit Sub
    End If
    With ActiveSheet.Shapes("背景").Fill
        .Visible = msoTrue
        .UserPicture FileName                 ' ここ
        .TextureTile = msoFalse
        .RotateWithObject = msoTrue
    End With
（とおりすがり） 2021/11/05(金) 10:19

コメント返信：

[ 一覧(最新更新順) ]

[[20211101164235]] 『マクロで図形上の日本語フォント変更と図形背景を』（たいたい） ページの最後に飛ぶ

[[20211101164235]]　『マクロで図形上の日本語フォント変更と図形背景を』（たいたい）　ページの最後に飛ぶ