2018年5月14日月曜日

【マクロ】スライサーの挿入と位置取り

下記のコードでスライサーを挿入する。

Worksheets("あいう").Select
Range("S8:AD50").Select
If TypeName(Selection) <> "Range" Then Exit Sub
For Each shp In ActiveSheet.Shapes
' 図形の配置されているセル範囲をオブジェクト変数にセット
Set Rng = Range(shp.TopLeftCell, shp.BottomRightCell)
' 図形の配置されているセル範囲と
' 選択されているセル範囲が重なっているときに図形を削除
If Not (Intersect(Rng, Selection) Is Nothing) Then
shp.Delete
End If
Next
Range("K1").Select
Worksheets("テーブル").Select
ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.ListObjects("テーブル"), "月"). _
Slicers.Add Worksheets("あいう"), , "月", "月7", 157, 1136, 216, 175

テーブルの項目「月」のスライサーを挿入する。
しかし、既に「月」のスライサーが存在している場合、
"月", "月7"としておくと、「月7」と別名でスライサーを挿入してくれる。
この1行で同じ項目のスライサーが2個作れる。

次にスライサーの位置だが、157, 1136, 216, 175
左から上からの位置,左からの位置,幅,高さとなっている。
これはセルの位置座標を表している。
オブジェクト座標ではないので注意が必要だ。

そこでセルの位置を取得するコードが下記だ。
調べたいセルを選択し実行する。

Sub 座標取得()
With Selection
MsgBox "行1端からの座標は" & .Top & "ポイントです。" & vbCrLf & _
       "A列端からの座標は" & .Left & "ポイントです。" & vbCrLf & _
       "セル範囲の高さの座標は" & .Height & "ポイントです。" & vbCrLf & _
       "セル範囲の幅の座標は" & .Width & "ポイントです。"
End With
End Sub

行1端からの座標は144ポイント。    上からの位置
A列端からの座標は1136.25ポイント。  右からの位置
セル範囲の高さの座標は175.5ポイント。 図形の高さ
セル範囲の幅の座標は216ポイント。   図形の幅

MsgBoxの箇所をDebug.Printにすると
イミディエイトウィンドウに書き込まれる。

Sub 座標取得()
With Selection
Debug.Print "上から" & .Top & "ポイント。" & vbCrLf & _
       "右から" & .Left & "ポイント。" & vbCrLf & _
       "高さ" & .Height & "ポイント。" & vbCrLf & _
       "幅" & .Width & "ポイント。"
End With
End Sub

こちらの方が使い勝手が良いだろう。



スライサーの削除は

ActiveSheet.Shapes.Range(Array("日", "市", "地区")).Delete

これを使っているが・・・他にコードあるのか・・・。





0 件のコメント:

コメントを投稿