『ロックを使わず図形をロックする方法』（もった）
要約のとおりなのですが、シートに配置した図形(オートシェイプ)を
シートのロックを使わずに選択も動かすこともできないようにしたいです
マウスカーソルをあてても指アイコンにならないようにしたいので、
何もしないマクロを割り当てておく、というのもできません
Private Sub Worksheet_Activate()
Dim shp As Shape
Set shp = Me.Shapes("シェイプ") ' 透明シェイプの名前を指定
shp.Locked = True ' シェイプの選択を無効化
shp.OnAction = "" ' クリックしても何も起きないようにする
shp.Placement = xlFreeFloating ' セルと一緒に動かない
Msgbox"テスト"
End Sub
としてみましたが、選択も移動もなんでもできます
テストにメッセージボックスを配置しましが、こちらはシートを開くたびに表示されているので、実行自体はされているようです
よろしくおねがします
＜ 使用 Excel：Excel2021、使用 OS：Windows10 ＞
オートシェープのLockedプロパティはシートの保護をしていないと有効にならないので、 この方法では無理でしょう
何かのタイミング(イベント)で元の位置に戻すようなマクロ実行するとか なにか代替案を探すとして、どうしてそのような事をしたいのか、書いてみてはどうでしょう （´・ω・`） 2025/02/25(火) 17:36:14
EXCELでWEBフォームみたいなのをシート状につくっているのですが
テキストボックスを配置して、その装飾にオートシェイプで、角に丸みのある枠線を書いたり
選択時にフォーカスされるようにしているのですが、ロックしないとズレてしまったり
配置している近くのセルに入ってしまったりするので、大きな四角を配置してその上に
フォームを作ろうと思いましたが、やはり選択できるとズレてしまいます
（もった） 2025/02/25(火) 18:05:48
そういう目的なら、USERFORMの利用じゃないでしょうか。 （xyz） 2025/02/25(火) 18:58:44
シートの保護すればいいとおもいますが シートの保護ができない理由はなんですか？ （´・ω・`） 2025/02/25(火) 19:06:42
ご指摘のとおり、シートの保護が第一候補でしょうね。 まずはそちらを検討されてはいかがですか？
（xyz） 2025/02/25(火) 19:23:32
シート保護をすればいいのですが、複数行を選択しての削除も行うのでそれができなくなるのが困りました
チェックボックスをつくりチェックだけを削除するようなコードを書いてもロックされているのでエラーがでました
もっと厳密に削除範囲を指定すれば回避できるのかもしれませんが私の技術ではできませんでした
シート背景については、ご指摘のとおりとんでもない見た目になるし位置合わせなどで現実的ではありませんでした
（もった） 2025/02/26(水) 02:16:58
>チェックボックスをつくりチェックだけを削除するようなコードを書いてもロックされているのでエラーがでました マクロ内でロックを外して削除して再度ロックする っていうのが一番簡単です （´・ω・`） 2025/02/26(水) 09:05:08
行の削除も同様に、マクロで対応（保護解除、選択行の行削除、再保護）をすればよいでしょう。 頻繁にそれを行うなら、コマンドボタンをシートに置いてもよいと思います。 （xyz） 2025/02/26(水) 11:53:56
> USERFORMは考えましたがやはり別ウインドウで出てきたりして操作感が変わってしまうので > ちょっと個人的な違和感がありました
ユーザーフォームをシートの子ウィンドウにすればどうでしょう。 シートの特定位置に固定表示できます。
下記の白茶さんと私のコードが参考になるかと。
[[20250123125234]]『ユーザーフォーム(UserForm1)の移動につきまして』（はる）
（hatena） 2025/02/26(水) 14:49:22
上記で紹介した方法で、ユーザーフォームをシート上の指定した位置に固定表示できます。 エクセルウィンドウの子ウィンドウになってますのでウィンドウを動かしても一緒に動きます。 ただし、ユーザーフォームのタイトルバーをドラッグすると移動するし、 枠をドラッグするとサイズ変更できます。 これでは希望と異なると思いますので、 タイトルバー非表示、枠なしにすれば移動もサイズ変更もできなくできます。 その方法は下記で紹介しています。
タイトルバーのないユーザーフォームをドラッグで移動 - hatena chips https://hatenachips.blog.fc2.com/blog-entry-419.html
上記は64bit非対応のコードなので64bit対応に書き直して、 [[20250123125234]] のコードに追加したものを置いておきます。
-----------------------------------------------------
Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr Private Declare PtrSafe Sub ReleaseCapture Lib "user32" () Private Const WM_NCLBUTTONDOWN = &HA1 Private Const HTCAPTION = 2
#If Win64 Then Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr #Else Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr #End If
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As LongPtr) As Long
Const GWL_STYLE = (-16&) Const GWL_EXSTYLE = (-20&) Const WS_CAPTION = &HC00000 Const WS_EX_DLGMODALFRAME = &H1&
Private Declare PtrSafe Function SetParent Lib "user32" (ByVal hWndChild As LongPtr, ByVal hWndNewParent As LongPtr) As LongPtr Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc.dll" (ByVal IAcessible As Object, ByRef hwnd As LongPtr) As Long Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
'kFormNonCaption関数
'ユーザーフォームのタイトルバー非表示
'引数：uf ユーザーフォーム
' flat True=フラットなウィンドウにする(枠無し)
'戻値：0=失敗 0<>成功 変更前のウィンドウスタイルの値
Function kFormNonCaption(ByVal uf As Object, Optional ByVal flat As Boolean) As LongPtr
Dim wnd As LongPtr, ih#
ih = uf.InsideHeight
WindowFromAccessibleObject uf, wnd
If flat Then SetWindowLongPtr wnd, GWL_EXSTYLE, GetWindowLongPtr(wnd, GWL_EXSTYLE) And Not WS_EX_DLGMODALFRAME
kFormNonCaption = SetWindowLongPtr(wnd, GWL_STYLE, GetWindowLongPtr(wnd, GWL_STYLE) And Not WS_CAPTION)
DrawMenuBar wnd
uf.Height = uf.Height - uf.InsideHeight + ih
End Function
Private Sub UserForm_Initialize()
Dim structWndowPosition As RECT
GetWindowRect Application.hwnd, structWndowPosition
Dim dblX As Double, dblY As Double
With ActiveWindow
dblX = (.PointsToScreenPixelsX(0) - structWndowPosition.Left) / 96 * 72 + Range("A2").Left * .Zoom / 100
dblY = (.PointsToScreenPixelsY(0) - structWndowPosition.Top) / 96 * 72 + Range("A2").Top * .Zoom / 100
End With
With Me
.StartUpPosition = 0
.Left = dblX
.Top = dblY
End With
kFormNonCaption Me, True 'タイトルバー非表示 枠無し
Dim hMe As LongPtr
WindowFromAccessibleObject Me, hMe
SetParent hMe, Application.hwnd '子ウィンドウ化
End Sub ---------------------------------------------------- （hatena） 2025/02/26(水) 15:53:14
図形をロック、シートは保護しておいて、行削除はマクロで対応というので十分だという気もしますね。
Office TANAKA - シートの操作[保護/解除する]
http://officetanaka.net/excel/vba/sheet/sheet07.htm
（hatena） 2025/02/26(水) 16:20:06
上記のOffice TANAKA さんのページにある
ActiveSheet.Protect UserInterfaceOnly:=True
でプロテクトをかければ、マクロからはエラーなく操作できます。
（hatena） 2025/02/28(金) 10:57:55
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.