Note: The other languages of the website are Google-translated. Back to English

Excelで指定されたセル値に基づいて/依存して形状サイズを自動変更するにはどうすればよいですか?

指定したセルの値に基づいて形状サイズを自動的に変更する場合は、この記事が役立ちます。

VBAコードを使用して、指定したセル値に基づいて形状サイズを自動変更します


VBAコードを使用して、指定したセル値に基づいて形状サイズを自動変更します

次のVBAコードは、現在のワークシートで指定されたセル値に基づいて特定の形状サイズを変更するのに役立ちます。 次のようにしてください。

1.サイズを変更する必要のある形状のシートタブを右クリックし、[ コードを表示 右クリックメニューから。

2。 の中に アプリケーション向け Microsoft Visual Basic ウィンドウで、次のVBAコードをコピーしてコードウィンドウに貼り付けます。

VBAコード:Excelで指定されたセル値に基づいて形状サイズを自動変更します

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Row = 2 And Target.Column = 1 Then
        Call SizeCircle("Oval 2", Val(Target.Value))
    End If
End Sub
Sub SizeCircle(Name As String, Diameter)
    Dim xCenterX As Single
    Dim xCenterY As Single
    Dim xCircle As Shape
    Dim xDiameter As Single
    On Error GoTo ExitSub
    xDiameter = Diameter
    If xDiameter > 10 Then xDiameter = 10
    If xDiameter < 1 Then xDiameter = 1
    Set xCircle = ActiveSheet.Shapes(Name)
    With xCircle
        xCenterX = .Left + (.Width / 2)
        xCenterY = .Top + (.Height / 2)
        .Width = Application.CentimetersToPoints(xDiameter)
        .Height = Application.CentimetersToPoints(xDiameter)
        .Left = xCenterX - (.Width / 2)
        .Top = xCenterY - (.Height / 2)
    End With
ExitSub:
End Sub

注意:コードでは、「オーバル2」は、サイズを変更する形状名です。 そして 行= 2, 列= 1 形状「楕円2」のサイズがA2の値で変更されることを意味します。 必要に応じて変更してください。

異なるセル値に基づいて複数の形状の自動サイズ変更を行うには、以下のVBAコードを適用してください。

VBAコード:Excelで指定されたさまざまなセルの値に基づいて複数の図形のサイズを自動変更

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xAddress As String
    On Error Resume Next
    If Target.CountLarge = 1 Then
        xAddress = Target.Address(0, 0)
        If xAddress = "A1" Then
            Call SizeCircle("Oval 1", Val(Target.Value))
        ElseIf xAddress = "A2" Then
            Call SizeCircle("Smiley Face 3", Val(Target.Value))
        ElseIf xAddress = "A3" Then
            Call SizeCircle("Heart 2", Val(Target.Value))
        End If
    End If
End Sub

Sub SizeCircle(Name As String, Diameter)
    Dim xCenterX As Single
    Dim xCenterY As Single
    Dim xCircle As Shape
    Dim xDiameter As Single
    On Error GoTo ExitSub
    xDiameter = Diameter
    If xDiameter > 10 Then xDiameter = 10
    If xDiameter < 1 Then xDiameter = 1
    Set xCircle = ActiveSheet.Shapes(Name)
    With xCircle
        xCenterX = .Left + (.Width / 2)
        xCenterY = .Top + (.Height / 2)
        .Width = Application.CentimetersToPoints(xDiameter)
        .Height = Application.CentimetersToPoints(xDiameter)
        .Left = xCenterX - (.Width / 2)
        .Top = xCenterY - (.Height / 2)
    End With
ExitSub:
End Sub

注意:

1)コードでは、「オーバル1"、"スマイリーフェイス3"と"ハート3」は、サイズを自動的に変更するシェイプの名前です。 そして A1, A2 及びA3 形状のサイズを自動変更する値のセルです。
2)形状を追加したい場合は、線を追加してください "ElseIf xAddress = "A3" Then"と "Call SizeCircle(" Heart 2 "、Val(Target.Value))「最初の上」終了する場合「コードの行。必要に応じてセルアドレスと形状名を変更します。

3。 押す 他の + Q キーを同時に閉じて アプリケーション向け Microsoft Visual Basic 窓。

これ以降、セルA2の値を変更すると、形状楕円2のサイズが自動的に変更されます。 スクリーンショットを参照してください:

または、セルA1、A2、A3の値を変更して、対応する形状「楕円形1」、「スマイリーフェイス3」、「ハート3」のサイズを自動的に変更します。 スクリーンショットを参照してください:

注意:セル値が10を超えると、形状サイズは変更されなくなります。


現在のExcelブックのすべての図形を一覧表示してエクスポートします。

世界 グラフィックのエクスポート の有用性 Kutools for Excel 以下のスクリーンショットのように、現在のワークブック内のすべての図形をすばやく一覧表示し、それらすべてを特定のフォルダーに一度にエクスポートできます。 ダウンロードして今すぐ試してみてください! (30-日フリートレイル)


関連記事:


最高のオフィス生産性ツール

Kutools for Excelはほとんどの問題を解決し、生産性を80%向上させます

  • 再利用: すばやく挿入 複雑な数式、チャート および以前に使用したものすべて。 セルを暗号化する パスワード付き。 メーリングリストを作成する そしてメールを送る...
  • スーパーフォーミュラバー (複数行のテキストと数式を簡単に編集できます); 読書レイアウト (多数のセルを簡単に読み取って編集する); フィルター範囲に貼り付け...
  • セル/行/列をマージする データを失うことなく; 分割セルコンテンツ; 重複する行/列を組み合わせる...重複セルを防止します。 範囲を比較する...
  • [複製]または[一意]を選択します 行; 空白行を選択 (すべてのセルは空です); スーパーファインドとファジーファインド 多くのワークブックで; ランダム選択...
  • 正確なコピー 数式参照を変更せずに複数のセル。 参照の自動作成 複数のシートに; 箇条書きを挿入、チェックボックスなど...
  • テキストを抽出、テキストの追加、位置による削除、 スペースを削除する; ページング小計の作成と印刷。 セルの内容とコメントを変換する...
  • スーパーフィルター (フィルタースキームを保存して他のシートに適用します); 高度な並べ替え 月/週/日、頻度など。 特殊フィルター 太字、斜体...
  • ワークブックとワークシートを組み合わせる; キー列に基づいてテーブルをマージします。 データを複数のシートに分割; xls、xlsx、PDFをバッチ変換...
  • 300 以上の強力な機能. Office / Excel 2007-2021 および 365 をサポートします。すべての言語をサポートします。 企業や組織に簡単に導入できます。 フル機能の 30 日間無料トライアル。 60日間の返金保証。
kteタブ201905

Officeタブは、タブ付きのインターフェイスをOfficeにもたらし、作​​業をはるかに簡単にします

  • Word、Excel、PowerPointでタブ付きの編集と読み取りを有効にする、パブリッシャー、アクセス、Visioおよびプロジェクト。
  • 新しいウィンドウではなく、同じウィンドウの新しいタブで複数のドキュメントを開いて作成します。
  • 生産性を 50% 向上させ、毎日何百回もマウス クリックを減らすことができます!
officetab下部
コメントを並べ替える
コメント (16)
まだ評価はありません。 最初に評価してください!
このコメントは、サイトのモデレーターによって最小化されました
それぞれ異なるセルに応じて、複数の形状でこれをどのように実行しますか?
このコメントは、サイトのモデレーターによって最小化されました
親愛なるジェイド、
記事は新しいコードセクションで更新され、それぞれが異なるセルに応じて複数の形状で実行するのに役立ちます。 コメントありがとうございます。

宜しくお願いします、
結晶
このコメントは、サイトのモデレーターによって最小化されました
自分の形に名前を付けるにはどうすればよいですか? 上記の例では、描いた円にOval 2という名前をどのように割り当てますか?
このコメントは、サイトのモデレーターによって最小化されました
親愛なるランジット、
図形に名前を付けるには、この図形を選択し、名前ボックスに図形名を入力して、Enterキーを押してください。 下の画像を参照してください。
このコメントは、サイトのモデレーターによって最小化されました
こんにちは、同じモジュール内の複数のセルにリンクされた複数の形状に対して同じものを複製するにはどうすればよいですか?
このコメントは、サイトのモデレーターによって最小化されました
親愛なるアビナヤ、
記事は新しいコードセクションで更新され、それぞれが異なるセルに応じて複数の形状で実行するのに役立ちます。 コメントありがとうございます。

宜しくお願いします、
結晶
このコメントは、サイトのモデレーターによって最小化されました
こんにちは、
私はあなたの投稿を使って自分のVBAコードを書こうとしましたが、それほど進んでいないようです。 主な理由は、私がVBAを本当に理解しておらず、あなたを適応させようとしているからです。 私はあなたが助けることができるかどうか疑問に思いました。 セルの値に応じて長方形の長さを変更したいのですが。 長方形は同じままで、長さを変更する場合は幅を希望します。 両方の左側の頂点を同じ場所に残し、右側に長くしたいと思います。 これは可能ですか?
ありがとうございました
このコメントは、サイトのモデレーターによって最小化されました
親愛なるLAN、
次のVBAコードで問題が解決することを願っています。 (楕円形1を自分の形の名前に置き換えてください)

プライベートサブワークシート_Change(ByValターゲットを範囲として)
エラーで次の再開
Target.Row=2かつTarget.Column=1の場合
SizeCircle( "Oval 1"、Val(Target.Value))を呼び出します
終了する場合
End Subの
Sub SizeCircle(Name As String、Diameter)
形状としての薄暗いxCircle
シングルとしての薄暗いxDiameter
エラー時GoToExitSub
xDiameter=直径
xDiameter>10の場合xDiameter=10
xDiameter<1の場合xDiameter=1
xCircle = ActiveSheet.Shapes(Name)を設定します
xCircle.ScaleWidth 1.5、msoFalse、msoScaleFromTopLeft
xCircleを使用
.LockAspectRatio = msoFalse
.Width = Application.CentimetersToPoints(xDiameter)
最後に
ExitSub:
End Subの
このコメントは、サイトのモデレーターによって最小化されました
こんにちは、図形を5次元で拡大する方法はありますか(図形のサイズを5つ増やすのではなく、水平方向に3つ、垂直方向にXNUMXつ増やします)。
このコメントは、サイトのモデレーターによって最小化されました
親愛なるサム、
次のVBAスクリプトは、問題の解決に役立ちます。 そして、1つの次元はセルA1とBXNUMXです。

プライベートサブワークシート_Change(ByValターゲットを範囲として)
エラーで次の再開
Target.Count=1の場合Then
交差しない場合(Target、Range( "A1:B1"))は何もありません
SizeCircle( "Oval 2"、Array(Val(Range( "A1")。Value)、Val(Range( "B1")。Value)))を呼び出します
終了する場合
終了する場合
End Subの
Sub SizeCircle(Name As String、Arr As Variant)
薄暗い私は長く
単一として薄暗いxCenterX
単一として薄暗いxCenterY
形状としての薄暗いxCircle
エラー時GoToExitSub
I = 0の場合UBound(Arr)へ
Arr(I)>10の場合
Arr(I)= 10
ElseIf Arr(I)<1 Then
Arr(I)= 1
終了する場合
次へ
xCircle = ActiveSheet.Shapes(Name)を設定します
xCircleを使用
xCenterX = .Left +(.Width / 2)
xCenterY = .Top +(.Height / 2)
.Width = Application.CentimetersToPoints(Arr(0))
.Height = Application.CentimetersToPoints(Arr(1))
.Left = xCenterX-(.Width / 2)
.Top = xCenterY-(.Height / 2)
最後に
ExitSub:
End Subの
このコメントは、サイトのモデレーターによって最小化されました
画像でこれを行う方法はありますか? 投稿されたコードを使用して運が悪いようです。

リーダーボードの5つの画像、1番目の画像または1番目の画像を大きくしたい。 したがって、2つの固定画像サイズを使用します。1番目ではない場合は2x2、4番目に配置する場合は1x1です(たとえば)。 ランキングはすでに設定されているので、それを使用して各画像の特定のセルにサイズを作成できます(つまり、IFステートメントを使用してIF RANKが最初のサイズ幅は2です)。 しかし、私のVBAはかなり弱いです。

基本的に、シートの更新時に、画像サイズのセルを確認し、各画像サイズを特定の画像サイズのセルの結果に設定します。 上記のVBAでは、それがどのように機能するかはわかりませんが、簡単なはずです。
このコメントは、サイトのモデレーターによって最小化されました
こんにちはクリスタル、

特定のセルから色(赤いセル=赤い形)と名前を選択する方法があるかどうかをお聞きしたいと思います。 VBAからフォームを自動的に作成することも可能でしょうか?

よろしくお願いします:)

小早川 薫
このコメントは、サイトのモデレーターによって最小化されました
こんにちはクリスタル
長さ、幅に基づいて決定する必要がある立方体、三角形、ボックスの辺を決定する場合はどうなりますか? 私を助けてください

ありがとうございました
チェアリル
このコメントは、サイトのモデレーターによって最小化されました
こんにちは議長、
申し訳ありませんが、まだそれを助けることはできません。 ご意見ありがとうございます。
このコメントは、サイトのモデレーターによって最小化されました
サイズを設定するために使用しているセルが、手動で入力した静的な値ではなく、数式の結果である場合、これを機能させる方法はありますか?
このコメントは、サイトのモデレーターによって最小化されました
こんにちはmathnz、以下のVBAコードは、問題の解決に役立ちます。コード内の値セルと形状名を、独自のデータに基づいて変更する必要があります。
プライベートサブWorksheet_Calculate()
'によって更新されました Extendoffice 20211105
エラーで次の再開
SizeCircle( "Oval 1"、Val(Range( "A1")。Value))を呼び出します 'A1は値セル、楕円1は形状名です
SizeCircle( "Smiley Face 2"、Val(Range( "A2")。Value))を呼び出します
SizeCircle( "Heart 3"、Val(Range( "A3")。Value))を呼び出します

End Subの
プライベートサブワークシート_Change(ByValターゲットを範囲として)
Dim xAddress を文字列として
エラーで次の再開
Target.CountLarge=1の場合Then
xAddress = Target.Address(0、0)
xAddress="A1"の場合Then
SizeCircle( "Oval 1"、Val(Target.Value))を呼び出します
ElseIf xAddress = "A2" Then
SizeCircle( "Smiley Face 2"、Val(Target.Value))を呼び出します
ElseIf xAddress = "A3" Then
SizeCircle( "Heart 3"、Val(Target.Value))を呼び出します

終了する場合
終了する場合
End Subの

Sub SizeCircle(Name As String、Diameter)
単一として薄暗いxCenterX
単一として薄暗いxCenterY
形状としての薄暗いxCircle
シングルとしての薄暗いxDiameter
エラー時GoToExitSub
xDiameter=直径
xDiameter>10の場合xDiameter=10
xDiameter<1の場合xDiameter=1
xCircle = ActiveSheet.Shapes(Name)を設定します
xCircleを使用
xCenterX = .Left +(.Width / 2)
xCenterY = .Top +(.Height / 2)
.Width = Application.CentimetersToPoints(xDiameter)
.Height = Application.CentimetersToPoints(xDiameter)
.Left = xCenterX-(.Width / 2)
.Top = xCenterY-(.Height / 2)
最後に
ExitSub:
End Subの

ここにはまだコメントが投稿されていません
あなたのコメントを残す
ゲストとして投稿
×
この投稿を評価:
0   文字
推奨される場所

フォローする

著作権©の2009 - WWW。extendoffice.com。 | | 全著作権所有。 搭載 ExtendOffice。 | サイトマップ
MicrosoftおよびOfficeのロゴは、米国MicrosoftCorporationの米国およびその他の国における商標または登録商標です。
SectigoSSLで保護