| |
大変遅くなりました
yoshiさん ありがとうございます
長いので 投稿を3回に分けました
>マウスカーソルの移動でウィンドウの切替えを行うということですか。
>違和感のあるUIのような気がします。
>通常、ウィンドウ整列した状態ではマウスカーソルに合わせてウィンドウが切替わらないので…
>それはさておき、うまくいかない点についてですが…
>なんかロジックが雑多で確実性に欠けてるように思います。
>簡潔にちょっと直してみました。
ありがとうございました
希望の動作かないました
実際に動かしてみると、やはり使い辛い面がありますね
やりたかったことは
フォームやプルダウン等からの入力補助みたいなものは作成したことがあったのですが
複数の表から選択（表シートも多有り）するような場合、シートを2つ並べて
入力したほうが利用しやすいような気がしていました
今回、そんな状況もあったので、試しに作成してみました
左シート：シート選択 および 選択データ書き込み
右シート： 表より選択
左シートのデータを元に各帳票作成みたいな・・・
わかりにくいと思うので、動作確認用マクロつけました
よろしければ動かしてみてください
モニタ17-19インチで表示のイメージです
新規ブックに、コードをコピー後
Module2 の SET_V() 実行
シート1の右のトグルボタンを押し、2画表示
右シートの表を左からwクリックで選択すると
単一選択項目は背景色が水色
複数選択項目は背景色が緑色
最終項目を選択すると背景色が橙色 となります
この時、右シートの表示外S、T列に選択値が記載されます
また、上位項目からの再選択が可能です
想像していたよりか利用しにくいみたいな感じで・・(~_~;)
で、下記2点アドバイスあればよろしくお願いたします
> この時、右シートの表示外S、T列に選択値が記載されます
を、
>左シート：シート選択 および 選択データ書き込み
したいと思っているのですが
Sub GET_dt()
Dim myRange As Range
For Each myRange In ActiveSheet.Range("T13:T23")
If myRange.Value > 0 Then
' Sheets(4).Range(Cells(myRange.Row, 19), Cells(myRange.Row, 20)).Select
' Sheets(4).Range(Cells(myRange.Row, 19), Cells(myRange.Row, 20)).Copy
Sheets(4).Range("S18:T18").Copy
Windows("hoge.xls:1").Activate
'Sheets(1).Range(Cells(23, 3), Cells(24, 3)).Select
'Sheets(1).Range(Cells(23, 3), Cells(24, 3)).Paste
'ActiveWindow.Parent.Sheets(1).Range(Cells(23, 3), Cells(24, 3)).Select
' ActiveWindow.Parent.Sheets(1).Range("C23:D23").Select
' Selection.Paste
ActiveWindow.Parent.Sheets(1).Range("C23:D23").Select
ActiveWindow.Parent.Sheets(1).Range("C23:D23").Paste '←エラー
MsgBox ""
Exit Sub
End If
Next myRange
End Sub
オブジェクトは、このプロパティまたはメソッドをサポートしていません。
となってしまいます
ここで、シートをアクティブにして、Ctrl+Vでは張り付きます・・・・
色々試しましたが、上記までしか辿りつけませんでした
アドバイスあればよろしくお願いいたします
また
>>この辺の処理、トラウマで、いつも、コードが動くように
>>訳もわからず改変していって？？になってしまいます
の典型みたいな記述が
Sheet2 の 表操作コードです
何とか希望の操作で動いていますが・・・・
自分で読み返すのいやなほどなので、見ていただくつもりはないのですが
再度書き直してもそれほど代わり映えしないような気がしています
一応の方針としては
レイアウトの変更等があっても
Sheet2モジュール
'行範囲指定で、表の列範囲を設定
Select Case ActiveCell.Row
Case 13 To 23 '表1
bk_c = 34
Call Me.MTRX_add_color(TGH_R_S, TGH_R_E, 1, 16, ActiveCell.Cells.Column)
のようにして設定することで
修正がないようにとしていますが・・・・・
全体的にこんな動作自体がばかげているような気もしますが
コードの作成の方向性とかありましたら
アドバイスあればよろしくお願いいたします
以下 コード
-------------------------------------------------
/////////////////////////////////////////////////////////////
'Sheet1
Option Explicit
Private Sub ToggleButton1_Click()
Dim ww!
'If ToggleButton1.Value = True Then
If ActiveWorkbook.Windows.Count = 1 Then
Application.ScreenUpdating = False
Sheet1.ToggleButton1.Caption = "戻る（１画面表示面）" '戻 る） → 戻る（１画面表示）
Sheet1.ToggleButton2.Caption = "非連動" '20090608
Parent.Unprotect
ActiveWindow.NewWindow
With Windows(Parent.Name & ":1")
.Activate
ActiveWorkbook.Windows.Arrange ArrangeStyle:=xlVertical
'ww = .Width + 2 - 240
'.Width = 240
ww = .Width + 2 - 190
.Width = 190
End With
With Windows(Parent.Name & ":2")
.Activate
.Left = .Left - ww: .Width = .Width + ww
End With
Sheets(2).Select
Parent.Protect Structure:=False, Windows:=True
Sheet1.ToggleButton2.Visible = True
'Sheet1.CommandButton2.Visible = True
' mouse_monitore_Start '連動トグルボタンに移動
If Sheet1.ToggleButton2.Value = True Then
mouse_monitore_Start
ElseIf Sheet1.ToggleButton2.Value = False Then
mouse_monitore_Stop
End If
' Sheet1.ToggleButton2.Value = True
' Application.ScreenUpdating = True
Else
Application.ScreenUpdating = False
Sheet1.ToggleButton1.Caption = "ＤＴセット(2画面表示)"
Parent.Unprotect
Windows(Parent.Name & ":2").Close
ActiveWindow.WindowState = xlMaximized
'mouse_monitore_Stop '連動トグルボタンに移動
Sheet1.ToggleButton2.Visible = False
'Sheet1.CommandButton2.Visible = False
Application.ScreenUpdating = True
End If
End Sub
Private Sub ToggleButton2_Click()
If Sheet1.ToggleButton2.Caption = "非連動" Then
Sheet1.ToggleButton2.Caption = "連動"
Sheet1.ToggleButton2.Value = False
mouse_monitore_Stop
ElseIf ToggleButton2.Caption = "連動" Then
Sheet1.ToggleButton2.Caption = "非連動"
Sheet1.ToggleButton2.Value = True
mouse_monitore_Start
End If
End Sub
/////////////////////////////////////////////////////////////
'ThisWorkbook
Option Explicit
Private Sub Workbook_Activate()
Dim wn As Window, aw As Window
Set aw = ActiveWindow
If ActiveWorkbook.Windows.Count > 1 Then
For Each wn In ActiveWorkbook.Windows
wn.Activate
Next
aw.Activate
'MsgBox ActiveWindow.Caption
If ActiveWindow.Caption <> "" And Sheet1.ToggleButton2.Caption = "非連動" Then
mouse_monitore_Start
End If
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
mouse_monitore_Stop
End Sub
Private Sub Workbook_Deactivate()
ActiveWindow.WindowState = xlMaximized
End Sub
/////////////////////////////////////////////////////////////
'Module1
'マウス監視 で ウィンドウをアクティブにする
Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function SetTimer Lib "user32" ( _
ByVal hWnd As Long, ByVal nIDEvent As Long _
, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Sub KillTimer Lib "user32" ( _
ByVal hWnd As Long, ByVal nIDEvent As Long)
Private Declare Sub GetCursorPos Lib "user32" ( _
lpPoint As POINTAPI)
Private Declare Function WindowFromPoint Lib "user32" ( _
ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Sub GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long)
Private TimerId As Long
Sub TimerProc(ByVal hWnd As Long, ByVal uMsg As Long _
, ByVal idEvent As Long, ByVal dwTime As Long)
On Error Resume Next
If Not ThisWorkbook Is ActiveWorkbook Then KillTimer 0, idEvent
Dim Point As POINTAPI, Caption$
GetCursorPos Point
hWnd = WindowFromPoint(Point.x, Point.y)
If hWnd = 0 Then Exit Sub
Caption = String(256, vbNullChar)
GetWindowText hWnd, Caption, Len(Caption)
Caption = Left$(Caption, InStr(Caption, vbNullChar) - 1)
If Caption = "" Then Exit Sub
If Mid(Caption, Len(Caption) - 1, 1) <> ":" Then Exit Sub
If ActiveWindow.Caption <> Caption Then Windows(Caption).Activate
End Sub
Sub mouse_monitore_Start()
If TimerId Then mouse_monitore_Stop
TimerId = SetTimer(0&, 0&, 0&, AddressOf TimerProc)
End Sub
Sub mouse_monitore_Stop()
If TimerId Then KillTimer 0&, TimerId
TimerId = 0
End Sub
/////////////////////////////////////////////////////////////
'Module2
Option Explicit
Sub SET_V()
MK_TGL
Cells.UnMerge
CELL_Merge1
CELL_Merge2
Sheets("Sheet2").Select
Range("A13:Q32").Select
With Selection.Borders
.LineStyle = xlContinuous
.Weight = xlThin
End With
Range("A13:A23").Select
Sheets("Sheet1").Select
End Sub
Public Sub MK_TGL()
Sheets(1).OLEObjects.Add _
ClassType:="Forms.ToggleButton.1", Link:=False, _
DisplayAsIcon:=False, Left:=71.25, Top:=11.25, Width:=87.75, Height:=18
Sheets(1).OLEObjects.Add _
ClassType:="Forms.ToggleButton.1", Link:=False, _
DisplayAsIcon:=False, Left:=9, Top:=11.25, Width:=50.25, Height:=18
Sheets(1).Select
Range("A6").FormulaR1C1 = "13"
Range("A7").FormulaR1C1 = "24"
Range("A7").AutoFill Destination:=Range("A7:A15"), Type:=xlFillSeries
End Sub
Sub CELL_Merge1()
Sheets(2).Range("" & _
"A13:A23,A24:B28,A29:B32," & _
"B13:B17,B18:B23,C13:F17," & _
"C18:F23,C24:Q24,C25:Q25," & _
"C26:Q26,C27:F28,C29:Q29," & _
"C30:Q30,C31:F32,G13:G16," & _
"G17:K17,G18:G21,G22:K22," & _
"G23:K23,G27:Q27,G28:Q28," & _
"G31:Q31,G32:Q32,H13:K13" & _
"").Merge
End Sub
Sub CELL_Merge2()
Sheets(2).Range("" & _
"H14:K14,H15:K15,H16:K16," & _
"H18:K18,H19:K19,H20:K20," & _
"H21:K21,L13:Q13,L14:Q14," & _
"L15:Q15,L16:Q16,L17:Q17," & _
"L18:Q18,L19:Q19,L20:Q20," & _
"L21:Q21,L22:Q22,L23:Q23" & _
"").Merge
End Sub
|
|
ON
- 09/6/12(金) 16:36 -
