Results of 1 - 1 of about 1039 for オートシェイプ (0.001 sec.)
- [[20190226153501]]
- #score: 6703
- @digest: 3e921402b4f5f8a3a3ff4f61ae6413a0
- @id: 78760
- @mdate: 2019-02-28T23:28:56Z
- @size: 12796
- @type: text/plain
- #keywords: 「乙 (24371), 乙」 (24371), 甲", (21970), 甲」 (20894), 「甲 (20111), msoshapeoval (10875), ルサ (6682), addshape (6621), msofalse (5685), shapes (5282), forecolor (5229), visible (4977), シェ (4968), single (4929), トシ (4795), ェイ (4677), weight (3610), height (3497), line (3467), イプ (3465), イズ (3081), width (2980), ） 一 (2710), activesheet (2584), 2019 (2406), サイ (2056), 図形 (1976), オー (1813), マナ (1666), 統一 (1541), 記載 (1439), 火) (1244)
- 『マクロによるオートシェイプ制御』（さら）
はじめまして。 よろしくお願いします。 C2〜C3、E2〜E3、G2〜G3 それぞれにIF関数の結果により、「なし」「甲」「乙」が入力されています。 D2〜D3、F2〜F3、H2〜H3 それぞれの上のセルが 「なし」何もしない+オートシェイプが存在したら削除する 「甲」ならD2、F2、H2にセルサイズでオートシェイプの〇 「乙」ならD3、F3、H3にセルサイズでオートシェイプの〇 としたいです。 どのようなマクロが可能でしょうか? ボタンで制御したいと考えております。 ＜ 使用 Excel:Excel2013、使用 OS:Windows7 ＞ ---- はじめまして。 よろしくお願いします。 ※2019.2.26 18:35修正させていただきました。 C2、C4、C6 それぞれにVLOOKUP関数の結果により、「なし」「甲」「乙」が入力されています。 C3〜D3、C5〜D5、C7〜D7 それぞれの上のセルが 「甲」ならD2、F2、H2にセルサイズでオートシェイプの〇 「乙」ならD3、F3、H3にセルサイズでオートシェイプの〇 「なし」何もしない+オートシェイプが存在したら削除する としたいです。 どのようなマクロが可能でしょうか? ボタンで制御したいと考えております。 イメージとしては下記になります。 --------------------------- C2 甲 C3 ○ D4 C4 甲 C5 ○ D5 C6 乙 C7 D7 ○ --------------------------- どなたかよろしくお願い致します （さら） 2019/02/26(火) 18:39 ---- オートシェイプでなく、〇を文字で表示、非表示ではだめなのでしょうか? （マナ） 2019/02/26(火) 18:53 ---- 普通に〇とセルに出力されるだけなら関数で出来るということでしょうか? 〇を表示させたいセルにはデータがあるのでオートシェイプではないとダメなのです... マクロ希望です(´・ω・`;) あと記載ミスがありました... C2 甲 C3 ○ D3 C4 甲 C5 ○ D5 C6 乙 C7 D7 ○ （さら） 2019/02/26(火) 20:02 ---- 実際のシートでも、この6セルだけなのでしょうか。 ＞C3〜D3、C5〜D5、C7〜D7 （マナ） 2019/02/26(火) 20:11 ---- いえ、増えることはあるかと思います(´・ω・`;) （さら） 2019/02/26(火) 21:05 ---- こんな感じでどうでしょうか。 事前準備（少ないなら手作業で） 1）所定のセルに ○ を用意 2）○にセル番地を含む名前（丸C3,丸D3など）をつける ここからマクロ 3）C2、C4、C6を順番に調べ 4）「甲」なら、 4-1）一つ下のセルの ○ のVisible=True 4-2）一つ下で、一つ右のセルの ○ のVisible=false 5）「乙」なら 5-1）一つ下のセルの ○ のVisible=false 5-2）一つ下で、一つ右のセルの ○ のVisible=True 6）それ以外なら 6-1）一つ下のセルの ○ のVisible=false 6-2）一つ下で、一つ右のセルの ○ のVisible=false 例えばC2が「乙」なら C 3セルの ○ （丸C3)を非表示にするということです。 activesheet.Shapes("丸C3").Visbe=False （マナ） 2019/02/26(火) 21:35 ---- マナ様 どの様に記述したら良いのかが全く分からないのですが... まず前提条件の1と2は手作業でも大丈夫です。 個数は28個になるのですが、自動化とかできるのでしょうか? もしくは過去ログであったのですが、オートシェイプを書くという方法も良いのかなと勝手に想像しています... 条件の方ですが、 If Range("C2").Value Like "*甲*" Then という感じで順番に記載していくっていうことですか? 全くの素人なのですみませんがご教授いただければと思います （さら） 2019/02/26(火) 22:28 ---- ＞If Range("C2").Value Like "*甲*" Then は、 If Range("C2").Value = "甲" Then です。 （マナ） 2019/02/26(火) 22:39 ---- Likeは不要なのですね! これでThenとElse、End Ifというのを作りたい行の分だけ記載するのでしょうか? それとも繰り返し処理的な記載で簡略化出来ますか? 変数でしたか? あと、ThenとElseの時のセル番地の指定ですが、Rangeで記載していくしかありませんか? もう1つCell.Offsetとかでしたか?これで繰り返し処理みたいなことは可能でしょうか? （さら） 2019/02/26(火) 23:04 ---- ＞これでThenとElse、End Ifというのを作りたい行の分だけ記載 まずは自力でできる書き方↑で構いません。 ＞繰り返し処理的な記載で簡略化 はそのあとで。 （マナ） 2019/02/26(火) 23:18 ---- Sub ○付け() Dim L, T, W, H As Variant Dim L2, T2, W2, H2 As Variant With Selection L = .Left T = .Top W = .Width H = .Height End With If W > H Then L2 = L + (W - H) / 2 T2 = T Else L2 = L T2 = T + (H - W) / 2 End If If W > H Then W2 = H H2 = H Else W2 = W H2 = W End If If Range("C2").Value = "甲" Then Range("C3").Select With ActiveSheet.Shapes.AddShape(msoShapeOval, L2, T2, W2, H2) .Fill.Visible = msoFalse .Line.ForeColor.RGB = RGB(0, 0, 0) .Line.Weight = 1 End With Else If Range("C2").Value = "乙" Then Range("D4").Select With ActiveSheet.Shapes.AddShape(msoShapeOval, L2, T2, W2, H2) .Fill.Visible = msoFalse .Line.ForeColor.RGB = RGB(0, 0, 0) .Line.Weight = 1 End With End If End If End Sub 他の掲示板より引用したものを少し改造しただけですが、○の位置がまばらでうまくいきません。 ご教授ください。。。 （さら） 2019/02/27(水) 06:13 ---- すいません、マナさんが指導しようとしている方向性をぶち壊してしまうかもしれませんが、考え方を変えるとシンプルになる別案です。 図形を表示/非表示したり削除するのではなく、全ての〇を削除後、改めて〇を全部描く、というロジックの方が、図形が既にあるかどうか等の処理が不要になります。 あと、注意点としては、〇の大きさや位置は、セルサイズが統一されていない場合におかしくなるSelectionなんてあてにならないものではなく、〇を置くセルの情報から得るべきだ、という事でしょうか。 （???） 2019/02/27(水) 11:20 ---- Sub test() Dim i As Long Dim L As Single Dim T As Single Dim W As Single For i = ActiveSheet.Shapes.Count To 1 Step -1 If ActiveSheet.Shapes(i).Name Like "test*" Then ActiveSheet.Shapes(i).Delete End If Next i For i = 2 To Cells(Rows.Count, "C").End(xlUp).Row Step 2 If Cells(i, "C").Value <> "" Then With Cells(i, "C").Offset(1, IIf(Cells(i, "C").Value = "甲", 0, 1)) If .Width < .Height Then W = .Width L = .Left T = .Top + (.Height - W) / 2 Else W = .Height L = .Left + (.Width - W) / 2 T = .Top End If With ActiveSheet.Shapes.AddShape(msoShapeOval, L, T, W, W) .Name = "test" & Cells(i, "C").Address(0, 0) .Fill.Visible = msoFalse .Line.ForeColor.RGB = RGB(0, 0, 0) .Line.Weight = 1 End With End With End If Next i End Sub （???） 2019/02/27(水) 11:25 ---- ???様 コメントありがとうございます。 >図形を表示/非表示したり削除するのではなく、全ての〇を削除後、改めて〇を全部描く、というロジックの方が、図形が既にあるかどうか等の処理が不要になります。 全ての〇を消すしてから新たに書くがやりたかったです! 説明下手ですみませんm(_ _)m 現状では必要な箇所以外のセルには〇やオートシェイプはないのですが、今後出てきた場合に備えて範囲を指定して削除は可能でしょうか? >あと、注意点としては、〇の大きさや位置は、セルサイズが統一されていない場合におかしくなるSelectionなんてあてにならないものではなく、〇を置くセルの情報から得るべきだ、という事でしょうか。 運用の上で仮にセルサイズが変わるとと思いましてSelectionとしてみた(コピペですが)のですが、現状としてはサイズは固定でも大丈夫な状況です。 （さら） 2019/02/27(水) 12:30 ---- コードを読んでもらえば判りますが、判定によって置いた〇には名前を付けているので、判定以外の図形は消しませんよ。 試しに何か図形を置いてから動かしてみると良いでしょう。 サイズについては、3行目と4行目の高さが違うのに、3行目の高さで4行目に〇を置く、なんてすると崩れます。 それに、マクロ実行前に何処を選択しているのかなんて不定ですし、複数の行や列を選択する事だってできる訳です。 セルではなく、画像を選択している場合もあります。 それらの場合でも、正しいサイズで〇を置くにはどうするか、を考えましょう。 貼り先セルを元にすると、行毎に高さが違っていても追従します。（縦横どっちが大きいかを判断していたので、行高さがバラバラな場合を考慮しているのだろうと推測しました） 逆に、全て同じ大きさの〇にしたいなら、例えばRange("A1")からだけサイズを得ておいて、行毎に変えるのは縦位置だけにすると良いです。 （???） 2019/02/27(水) 13:00 ---- こんにちは。 別シートでもいいので、○を表示させるセルを別に用意した方がいいと思います。 で、図のリンク貼り付けで持ってくる。 （でれすけ） 2019/02/27(水) 13:32 ---- 早速試してみました! いくつか改善したい点があります。 よろしくお願いします。 1.条件 現状→「甲」は正常に動きます。 「甲」以外の空白ではない場合は全て○に統一されている 希望→「甲」はそのままで大丈夫です 最初の投稿で書きました通り、「乙」ならD列に○、「なし」又は空白セルの場合は何もしないとしたい 2.範囲 希望→処理範囲を限定したい マクロ有効範囲→【B22:E31】と【B69:E78】 条件入力セル→それぞれ【B22、B24、B26、B28、B30】【B69、B71、B73、B75、B77】 上記を踏まえて修正してみたものが下記です Sub test() Dim i As Long Dim L As Single Dim T As Single Dim W As Single For i = ActiveSheet.Shapes.Count To 1 Step -1 If ActiveSheet.Shapes(i).Name Like "test*" Then ActiveSheet.Shapes(i).Delete End If Next i For i = 22 To Cells(Rows.Count, "B").End(xlUp).Row Step 2 If Cells(i, "B").Value <> "" Then With Cells(i, "B").Offset(1, IIf(Cells(i, "B").Value = "甲", 0, 2)) If .Width < .Height Then W = .Width L = .Left T = .Top + (.Height - W) / 2 Else W = .Height L = .Left + (.Width - W) / 2 T = .Top End If With ActiveSheet.Shapes.AddShape(msoShapeOval, L, T, W, W) .Name = "test" & Cells(i, "B").Address(0, 0) .Fill.Visible = msoFalse .Line.ForeColor.RGB = RGB(0, 0, 0) .Line.Weight = 1 End With End With End If Next i End Sub この状態だと範囲の指定が出来ておりません。 範囲の指定をして、実行ボタンを作成して完了としたいです。 完成した場合、このシートをコピーしても全て正常に動くでしょうか? また仮にの話ですが、○のサイズをセルサイズの90%で描きたい場合は、L、T、Wの式のどの場所に「 * 0.9」とすれば良いでしょうか? なかなか適当に入れてみたのですが、位置がずれてしまいます... よろしくお願いします! （さら） 2019/02/27(水) 18:14 ---- 追記失礼します。 1.条件のところも改善出来てません。 よろしくお願いしますm(_ _)m （さら） 2019/02/28(木) 01:07 ---- 「なし」「甲」「乙」という条件だったので、「なし」というのは空欄の事かと思ったのですが、"なし" と書かれているのですね。 しかも空欄もあるので、3択ではなく4択だった、と。 なら、"なし" の場合の条件を追加するだけですが、実は "無し" とかも…、とかでも良いようにしましょうか。 そして、C列を見て、C列またはD列に〇だったのが、B列をみて、B列またはD列に変えたようですが、これはそのまま活かします。 Sub test() Dim i As Long For i = ActiveSheet.Shapes.Count To 1 Step -1 If ActiveSheet.Shapes(i).Name Like "test*" Then ActiveSheet.Shapes(i).Delete End If Next i For i = 22 To 31 Step 2 Call testSub(i) Next i For i = 69 To 78 Step 2 Call testSub(i) Next i End Sub Sub testSub(i As Long) Dim L As Single Dim T As Single Dim W As Single Select Case Cells(i, "B").Value Case "甲", "乙" With Cells(i, "B").Offset(1, IIf(Cells(i, "B").Value = "甲", 0, 2)) If .Width < .Height Then W = .Width * 0.9 L = .Left + .Width * 0.05 T = .Top + (.Height - W) / 2 Else W = .Height * 0.9 L = .Left + (.Width - W) / 2 T = .Top + .Height * 0.05 End If With ActiveSheet.Shapes.AddShape(msoShapeOval, L, T, W, W) .Name = "test" & Cells(i, "B").Address(0, 0) .Fill.Visible = msoFalse .Line.ForeColor.RGB = RGB(0, 0, 0) .Line.Weight = 1 End With End With End Select End Sub （???） 2019/02/28(木) 09:56 ---- ???様 再度ありがとうございます! 無事に動作確認出来ました。 自分が修正した箇所と比較して勉強したいと思います。 また投稿することもあるかと思いますが、皆様よろしくお願い致しますm(*_ _)m （さら） 2019/03/01(金) 08:28... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201902/20190226153501.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97048 documents and 608239 words.
訪問者：