キャラクターの縁を白くしてみるテストでっす。
おつかれさまです。なずなです。
こんなかんじで質問を頂きました。
これと組み合わせて最終的な操作を
Accessで動くものを作ってみたいと思います。
全3回くらいじゃないでしょうか。
今回はずらっとシェイプを並べるところまでです。
- 今日の完成品
- 内容をざっくり決める
- Excel側のサンプルを作る
- シェイプを挿入してみる
- 操作対象のシートを返すFunctionを作る
- 引数を受け取ってシェイプを追加操作する
- メインのプロシージャ作成
今日の完成品
Sub 位置と幅を指定してシェイプを挿入する() Dim sh As Worksheet Set sh = TageSH 'A1セルに作成 予定シェイプの作成 sh, 1, 1, 50 'L列全てに挿入するテスト Dim i As Long For i = 5 To 15 予定シェイプの作成 sh, i, 13, 50 Next End Sub Sub 予定シェイプの作成(ByVal sh As Worksheet, ByVal top, ByVal left, ByVal w) Set shp = sh.Shapes.AddShape(msoShapeRectangle, 1, 1, 15, 15) '高さ shp.Height = 10 '幅 shp.Width = w '位置 shp.top = Cells(top, left).top '相対移動 shp.IncrementTop 5 shp.left = Cells(top, left).left End Sub '該当シートを返す Function TageSH() Dim bk As Workbook Set bk = ThisWorkbook Dim sh As Worksheet Set sh = bk.Worksheets("工程表") Set TageSH = sh End Function
以降は作業順番でつらつらっと書いていきます。
内容をざっくり決める
ツイッターのお話だけなので読み取りにくい部分もあります。
・作るのは工程表
・進捗バーと予定バーがあって色がわかれている
・最終的に消したいのは予定バー
・(書いてないけど)対象ブックにはマクロ置いちゃだめなことにする
・操作はAccessからやってみる。
Excel側のサンプルを作る
実際の仕事だとすでに使っているブックがあると思います。
シートをコピーしちゃって、それは「.xlsm」ファイルで作っちゃいましょう。
それがこんなものだとします。
シェイプを挿入してみる
ちょーど機能やりました。図形はShapesです。
最初に適当な□図形を挿入します。
そのあと「ぐぐったり」「プロパティを調べたり」して、
このコードを作りました。
'テスト用 Function 予定シェイプを確認してみる() Dim shp As Shape Set shp = ThisWorkbook.Worksheets(1).Shapes(1) '色 shp.BackgroundStyle = msoBackgroundStylePreset1 shp.ShapeStyle = msoShapeStylePreset9 '高さ shp.Height = 10 '幅 shp.Width = 100 '位置 shp.top = Cells(1, 1).top '相対移動 shp.IncrementTop 5 shp.left = Cells(1, 1).left End Function
適当な位置に作った図形の位置を変更、高さと幅を変更です。
相対位置を変えるメソッドがあるので、これで真ん中に寄せています。
操作対象のシートを返すFunctionを作る
最終的に操作するブックにはVBAが置けません。
つまり省略できないってことです。
後で変更がしやすいようにいまのうちに作っておきます。
Function TageSH() Dim bk As Workbook Set bk = ThisWorkbook Dim sh As Worksheet Set sh = bk.Worksheets("工程表") Set TageSH = sh End Function
こういうのです。
こうしておけばあとはThisWorkbookを変更するだけで、
他のプロシージャには変更不要で使えます。
引数を受け取ってシェイプを追加操作する
先に作ったものは場所もシートもプロシージャ内で決められてました。
あとで大量に作るので、引数で受け取って処理するように変更します。
Sub 予定シェイプの作成(ByVal sh As Worksheet, ByVal top, ByVal left, ByVal w) Set shp = sh.Shapes.AddShape(msoShapeRectangle, 1, 1, 15, 15) '高さ shp.Height = 10 '幅 shp.Width = w '位置 shp.top = Cells(top, left).top '相対移動 shp.IncrementTop 5 shp.left = Cells(top, left).left End Sub
それが完成品でも使われてるこちらです。
AddShapeってメソッドがあるんですねー(ぐぐった!)
作成段階で位置を指定できますが、そこはお好みで。
メインのプロシージャ作成
関数ができたらあとは使うものを作成して完了でっす。
Sub 位置と幅を指定してシェイプを挿入する() Dim sh As Worksheet Set sh = TageSH 'A1セルに作成 予定シェイプの作成 sh, 1, 1, 50 'L列全てに挿入するテスト Dim i As Long For i = 5 To 15 予定シェイプの作成 sh, i, 13, 50 Next End Sub
今回は列を固定です。
次回は列を変動させるところから!
ファイルごと欲し~なんて人がいたら
コメントかツイッターで連絡ください。
共有方法考えてみます。