Results of 1 - 1 of about 28 for 平均 平日 (0.001 sec.)
平均 (1366), 平日 (459)
- [[20100930194658]]
- #score: 10343
- @digest: 1b3fe8acf60f2e78a135a38a86acd218
- @id: 51549
- @mdate: 2014-09-27T22:02:23Z
- @size: 12588
- @type: text/plain
- #keywords: conttmp (92495), btnpaste (68557), btncopy (59588), cpypst (58145), btncut (51947), dobj (46405), commandbarbutton (42416), barm (30463), ccp (27077), dataobject (16103), typename (6021), withevents (5446), office (4987), enabled (4695), textbox (3947), nm (3942), ー& (3919), トメ (3714), ドイ (3678), メニ (3030), ロジ (2996), error (2837), シジ (2801), ニュ (2719), caption (2536), ャー (2378), private (2275), ドル (2061), ュー (2050), トカ (2050), resume (2028), ジェ (1918)
- 『テキストボックスでショートカットメニューを表示させたい』（キョロ）
いつもお世話になっています。 エクセルsheetにActiveXコントロールのTextBoxを貼り付けています。このTextBoxに右クリックでショートカットメニューを表示させたいのですが、何かいい方法はないでしょうか? 以前、こちらでユーザーフォームにあるTextBoxにオリジナルのショートカットメニューを表示させる方法がのっており、これなら!と試していますがうまくいきません…。 よろしくお願いします。 Excel2003 WindowsXP ---- こちらでってどこですか? sendkeyをつかっちゃたけど、その辺は適当に変えてください。 http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=52;id=FAQ (Jaka) ---- >オリジナルのショートカットメニューを表示させる方法 [[20100921183617]] ↑これですか? だとしたら・・・、 シートに貼り付けたActiveXControlには、適用できていませんね!! というか、私は、殆どシートをユーザーに触らせるようなコードは書かないので ↑これまで考慮してませんでした。 で、ご質問の件は、変数の型の違いやら、同じメソッドがユーザーフォームと シートに貼り付けたのとは、動作が違ったりで作動しません。 で、両方で使えるように考えてみました。 この場合、リンク先でも触れましたが、 メニュー表示やコピー&切取り&貼付動作を別のブックにてアドイン化してしまう方法を選択しました。 まず、新規ブックにて *VBEにて、「Microsoft Forms2.0 Object Library」を参照設定してください。 クラスモジュールを二つ作成してください。 クラス名は、Class1、Class2という既定名です。 Class1のモジュールに '============================================================= Option Explicit Private WithEvents btnCopy As Office.CommandBarButton Private WithEvents btnCut As Office.CommandBarButton Private WithEvents btnPaste As Office.CommandBarButton Private barM As Office.CommandBar Private conttmp As Object Const Ctxt As String = "TextBox" Const Clbl As String = "Label" Private cpt() As class2 '============================================================== Sub init(cmdb As Office.CommandBar, ct As Office.CommandBarButton, cpy As Office.CommandBarButton, pst As Office.CommandBarButton) 'コピーペーストクラスの初期化 インスタンス作成後、 '必ず最初に実行する メニューを登録する On Error Resume Next Set barM = cmdb Set btnCopy = cpy Set btnCut = ct Set btnPaste = pst On Error GoTo 0 End Sub '========================================================== Sub term() 'コピーペーストクラスの終了処理 ファイルのCloseみたいなもの On Error Resume Next Dim g0 As Long For g0 = LBound(cpt()) To UBound(cpt()) Set cpt(g0) = Nothing Next On Error GoTo 0 End Sub '==================================================== Sub add(ByVal Cobj As Object) 'コピーペーストメニューを表示するコントロールを登録する 'いまところ、TextboxとLabelだけ Dim g0 As Long On Error Resume Next g0 = UBound(cpt()) + 1 If Err.Number <> 0 Then g0 = 1 ReDim Preserve cpt(1 To g0) Set cpt(g0) = New class2 If TypeName(Cobj) = Ctxt Then Set cpt(g0).Txtev = Cobj ElseIf TypeName(Cobj) = Clbl Then Set cpt(g0).Lblev = Cobj End If Set cpt(g0).parent = Me cpt(g0).id = g0 On Error GoTo 0 End Sub '=========================================================== Sub callback(ByVal contP As Variant) '右クリックでのメニュー表示 Set conttmp = contP If TypeName(conttmp) = Ctxt Then btnCut.Enabled = True btnPaste.Enabled = conttmp.CanPaste ElseIf TypeName(conttmp) = Clbl Then btnCut.Enabled = False btnPaste.Enabled = False End If barM.ShowPopup End Sub '==================================================================== Private Sub btnCopy_Click( _ ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean) 'コピーが選択されたときの処理 Dim dobj As DataObject If TypeName(conttmp) = Ctxt Then Set dobj = New DataObject If conttmp.Value <> "" Then Set dobj = New DataObject dobj.SetText conttmp.SelText dobj.PutInClipboard Set dobj = Nothing End If ElseIf TypeName(conttmp) = Clbl Then Set dobj = New DataObject If conttmp.Caption <> "" Then Set dobj = New DataObject dobj.SetText conttmp.Caption dobj.PutInClipboard Set dobj = Nothing End If End If End Sub '============================================================== Private Sub btnCut_Click( _ ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean) '切り取りが選択されたときの処理 Dim dobj As DataObject If TypeName(conttmp) = Ctxt Then Set dobj = New DataObject If conttmp.Value <> "" Then Set dobj = New DataObject dobj.SetText conttmp.SelText dobj.PutInClipboard Set dobj = Nothing With conttmp .Text = WorksheetFunction.Replace(.Text, .SelStart + 1, .SelLength, "") End With End If End If End Sub '=============================================================== Private Sub btnPaste_Click( _ ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean) '貼付が選択されたときの処理 Dim dobj As DataObject If TypeName(conttmp) = Ctxt Then conttmp.Paste End If End Sub Class2のモジュールに '=============================================================== Option Explicit Public WithEvents Txtev As MSForms.TextBox Public WithEvents Lblev As MSForms.Label Public id As Long Private cpo As Object '=============================================================== Property Set parent(pcpo As Object) Set cpo = pcpo End Property '=============================================================== Private Sub Lblev_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) If Button = 2 Then cpo.callback Lblev End If End Sub '=============================================================== Private Sub Txtev_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) If Button = 2 Then cpo.callback Txtev End If End Sub 次にThisworkbookのモジュールに '=============================================================== Option Explicit Private col As Collection '=============================================================== Function ccp_open(nm As Variant) As Long On Error Resume Next Dim btnCopy As Office.CommandBarButton Dim btnCut As Office.CommandBarButton Dim btnPaste As Office.CommandBarButton Dim barM As Office.CommandBar ccp_open = 0 Call mk_menu(nm, barM, btnCut, btnCopy, btnPaste) With col .add New Class1, nm ccp_open = Err.Number If Err.Number = 0 Then .Item(nm).init barM, btnCut, btnCopy, btnPaste Else On Error Resume Next barM.Delete On Error GoTo 0 End If End With On Error GoTo 0 End Function '=============================================================== Sub ccp_add(nm As Variant, obj As Object) col(nm).add obj End Sub '=============================================================== Sub ccp_close(nm As Variant) On Error Resume Next col(nm).term Set col(nm) = Nothing col.Remove nm CommandBars(nm).Delete On Error GoTo 0 End Sub '=============================================================== Private Sub Workbook_BeforeClose(Cancel As Boolean) On Error Resume Next Set col = Nothing On Error GoTo 0 End Sub '=============================================================== Private Sub Workbook_Open() Set col = New Collection End Sub '=============================================================== Sub mk_menu(ByVal nm As Variant, barM As Office.CommandBar, btnCut As Office.CommandBarButton, btnCopy As Office.CommandBarButton, btnPaste As Office.CommandBarButton) 'メニュー作成 On Error Resume Next Application.CommandBars(nm).Delete Set barM = Application.CommandBars.add(nm, msoBarPopup, , True) With barM Set btnCut = .Controls.add(msoControlButton) btnCut.Style = msoButtonCaption btnCut.Caption = "切り取り" Set btnCopy = .Controls.add(msoControlButton) btnCopy.Caption = "コピー" btnCopy.Style = msoButtonCaption Set btnPaste = .Controls.add(msoControlButton) btnPaste.Caption = "貼り付け" btnPaste.Style = msoButtonCaption End With On Error GoTo 0 End Sub アドイン側のコードは以上です。 VBEにて、デバッグ------Vbprojectのコンパイルを実行し、エラーが出ないことを 確認してください。 VBEからExcelに戻ってください。 「ファイル」-----「名前を付けて保存」とクリックして、名前を付けて保存するダイアログを表示させてください。 「ファイルの種類」として、「Microsoft Excel アドイン (*.xla)」を選択してください。 保存フォルダが変わりますが、そのまま表示フォルダに保存します。 ファイル名は、cpypst.xla と命名してください。 一度、Excel本体を閉じてから、再度Excelを立ち上げてください。 再び、新規ブックとして、Book1が既定ブックとして作成されていることを 確認してください。 「ツール」----「アドイン」と起動して、アドインダイアログを表示させてください。 アドイン一覧に先に作成した「cpypst」があるはずです。 チェックを入れてOKをクリックしてください。 これで準備はOKです。アドインcpypst.xlaがインストールされました。 次投稿で使用方法を説明します。 ---- アドインcpypst.xlaのインターフェース プロシジャー名 ccp_open 機能 コピー&ペースト機能プロジェクトをオープンする 呼び出し形式 call Workbooks("cpypst.xla").ccp_open(nm) in nm プロジェクトハンドル名を指定する 他のプロジェクトと重複しない名前を指定します。 out ccp_open 0 正常にオープンされた 1 プロジェクトハンドル名が重複しています 備考 最初に必ず実行するプロシジャーです。 '====================================================================== プロシジャー名 ccp_Add 機能 コピー&ペーストメニューを表示するオブジェクトを登録する 呼び出し形式 call Workbooks("cpypst.xla").ccp_add(nm,obj) in nm プロジェクトハンドル名を指定する obj コピー&ペーストメニューを表示するオブジェクト いまところ、TextboxとLabelだけ 備考 ccp_Addで登録後、当該コントロールでは、コピ&ペースト のメニューが表示されます '==================================================================== プロシジャー名 ccp_close 機能 コピー&ペースト機能プロジェクトをクローズする 呼び出し形式 call Workbooks("cpypst.xla").ccp_close(nm) in nm プロジェクトハンドル名を指定する 備考 ファイルのクローズのように最後に実行するプロシジャーです。 以上です。 次投稿で実例で検証します。 ichinose ---- 例1 新規ブックにて（Sheet1 というシート名が存在する)、 Sheet1にコントロールツールボックスのテキストボックスを 二つ作成してください（TextBox1、TextBox2）。 Thisworkbookのモジュールに '=========================================================== Option Explicit Private Sub Workbook_BeforeClose(Cancel As Boolean) On Error Resume Next With Workbooks("cpypst.xla") .ccp_close ThisWorkbook.Name End With On Error GoTo 0 End Sub '============================================================= Private Sub Workbook_Open() With Workbooks("cpypst.xla") If .ccp_open(ThisWorkbook.Name) = 0 Then .ccp_Add ThisWorkbook.Name, Me.Worksheets("sheet1").OLEObjects("textbox1").Object .ccp_Add ThisWorkbook.Name, Me.Worksheets("sheet1").OLEObjects("textbox2").Object Else MsgBox "Set Can Not" End If End With End Sub 適当な名前で保存してください（例 BOOK1.XLS など)。 一度閉じた後、再度上記のBOOK1.XLSを開いてください。 二つのテキストボックスにて、コピー&ペーストメニューが右クリックで 表示されることを確認してください。 14/9/28 アドインcpypst.xla側のThisworkbookのモジュールに不具合がありましたので、 修正しました。 [[20140926184519]] このスレッドに参加している過程で発見しましたので、修正しました。 ichinose... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/201009/20100930194658.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97026 documents and 607984 words.
訪問者：