スキルアップ・問題解決なら、モーグにおまかせ！

オートシェイプ(msoshapepentagon)のプロパティー設定のコード化について
プロパティー項目は以下になります
　・塗りつぶしなし
　・高さをセル高さより小さく設定した
　
 
 
 

■お願い
・個別表題で書かずに連結してほしい（別投稿の件もおよそ同じ内容だと勝手に思っております）。
※連結して削除するか、解決扱いでクローズするなどしてどちらかに連結するのを推奨します。
※完全に別案件なら勘違いなので失礼しました。
 
・説明が短いため質問なのか荒らしなどの別途運営に対応依頼するべきなのか判断できません。
※必要な説明をしっかり書いてほしいです。回答を寄せるユーザーもただの一般ユーザーです。
 
・コードを作成する依頼とも取れなくもないのですがモーグの規約は作成依頼禁止となります。
※お手製コードを追記するなどして改善案を教えてもらうなどの、今までどこまで進捗があってどうなっているのかについて記載してほしい。
 
一応ChatGPTに投稿内容をそのままコピペして作成させたものをここに置いていきますが、
作成依頼に対する応答ではないので動作するか確認していません。参考資料に使ってもらって構いませんが実働するかは保証しません。
ネットで参考にした資料などの進捗を持って再度投稿していただくとほかの回答者が現れるかもしれません。
 
ChatGPTより引用　※結果の丸コピ

引用:
以下は、VBAで指定したプロパティーを持つペンタゴンのオートシェイプを作成するコードです。このコードは、セルA1から開始して、指定した高さよりも小さいペンタゴンを配置します。塗りつぶしはなしに設定されます。

vba
Sub CreatePentagon()
    Dim ws As Worksheet
    Dim shp As Shape
    Dim cellHeight As Single
    Dim pentagonHeight As Single
    Dim pentagonWidth As Single
    Dim leftPosition As Single
    Dim topPosition As Single
    
    ' 対象のシートを設定
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Sheet1 を適切なシート名に変更
    
    ' セル A1 の高さを取得
    cellHeight = ws.Range("A1").Height
    
    ' オートシェイプの高さをセルの高さよりも小さく設定
    pentagonHeight = cellHeight / 2
    
    ' オートシェイプの幅を高さに応じて計算
    pentagonWidth = pentagonHeight * (2 + Sqr(5)) / 2
    
    ' オートシェイプの左上隅の位置を計算
    leftPosition = ws.Range("A1").Left + (ws.Range("A1").Width - pentagonWidth) / 2
    topPosition = ws.Range("A1").Top + (cellHeight - pentagonHeight) / 2
    
    ' オートシェイプを追加
    Set shp = ws.Shapes.AddShape(msoShapePentagon, leftPosition, topPosition, pentagonWidth, pentagonHeight)
    
    ' オートシェイプのプロパティーを設定
    With shp
        .Fill.Transparency = 1 ' 塗りつぶしなし
        ' 他のプロパティー設定も可能
    End With
End Sub

参考にはなるかと。

Sub Sample()
  With Worksheets(1).Range("B2:C10")  'セル B2:C10 に合わせて
    With Worksheets(1).Shapes.AddShape(msoShapePentagon, .Left, .Top, .Width, .Height) '5角形を挿入
      .Fill.Visible = msoFalse  '塗りつぶしなし
      With .TextFrame
        .VerticalAlignment = xlVAlignCenter   '縦中央
        .HorizontalAlignment = xlHAlignCenter '横中央
        With .Characters
          .Text = "あいう"  'テキスト記入
          With .Font
            .Name = "Meiryo UI"                 'フォント名
            .Size = 30                          'フォントサイズ
            .ColorIndex = xlColorIndexAutomatic 'フォント色 自動
          End With
        End With
      End With
    End With
  End With
End Sub

早速にメーッセジを頂きありがとうございます。
参考にさせていただきます。