なずブログ

インフラSE、Java開発、リモートワークエンジニアな人のメモ帳

VBAでAccessから工程表のシェイプを操作する~その1~

f:id:nazuna_0124:20190922094103p:plain

キャラクターの縁を白くしてみるテストでっす。

おつかれさまです。なずなです。


こんなかんじで質問を頂きました。

f:id:nazuna_0124:20190922094259p:plain


これと組み合わせて最終的な操作を

Accessで動くものを作ってみたいと思います。

全3回くらいじゃないでしょうか。


今回はずらっとシェイプを並べるところまでです。



今日の完成品

f:id:nazuna_0124:20190922094521p:plain


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」ファイルで作っちゃいましょう。

f:id:nazuna_0124:20190922095030p:plain


それがこんなものだとします。


シェイプを挿入してみる

ちょーど機能やりました。図形は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

今回は列を固定です。

次回は列を変動させるところから!


ファイルごと欲し~なんて人がいたら

コメントかツイッターで連絡ください。


共有方法考えてみます。