Private Declare PtrSafe Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Integer
Private Sub CommandButton1_Click() Do If GetAsyncKeyState(VK_LBUTTON) Then ActiveCell.Value = "ここ" Exit Do End If Loop End Sub 0678デフォルトの名無しさん (ﾜｯﾁｮｲ ffb3-7LW1)2017/12/23(土) 06:43:21.92ID:F3cHZlpp0>>677で書き忘れ 標準モジュールの宣言部に Public Const VK_LBUTTON = &H1 の記述もしてあります。 0679デフォルトの名無しさん (ﾜｯﾁｮｲ cfb9-bqMz)2017/12/23(土) 07:46:11.28ID:8SavP0Th0>>677 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Count = 1 Then Target.Value = "ここ" End Sub
Sub test01() n = Worksheets("Sheet1").Shapes("Button 1").Name Worksheets("Sheet1").Shapes(n).Select Selection.Font.ColorIndex = 3 End Sub 0684デフォルトの名無しさん (ﾜｯﾁｮｲ 73e3-chJT)2017/12/23(土) 10:51:51.14ID:YCHexesv0 フォームコントロールボタンの文字の色を変えたいんだけど セレクトしない方法はないのですか？
Set n = Worksheets("Sheet1").Shapes("Button 1") n.Font.ColorIndex = 3
でも、殆どの処理はセレクト無しで書ける。 個人的にはセレクト無しで書けない場合でも何とかセレクトせずに書けないかを考える。 0695デフォルトの名無しさん (ﾜｯﾁｮｲ 93f7-vrKU)2017/12/24(日) 00:45:00.70ID:BN72T8jr0 まあ、大多数の用途では得られるメリットが少なすぎてSelectを消す意味は薄いけどな 0696デフォルトの名無しさん (ｱｰｸｾｰ Sx87-/hyL)2017/12/24(日) 01:23:50.46ID:2PxYmIQzx オブジェクトのプロパティにアクセスする処理でSelectメソッドはなるべく使わない コードの実行中にデバッグ作業を行ったときなどに予期しないオブジェクトが選択されて、アクセスしたいプロパティにアクセス出来ずエラーになることがよくあるからね Rangeオブジェクトを指定していたはずがShapeオブジェクトやOLEObjectオブジェクトを選んでいたりとか 0697デフォルトの名無しさん (ﾜｯﾁｮｲ cfb9-bqMz)2017/12/24(日) 01:43:15.08ID:O2udkTbW0 Selectは必ず代替手段があるから、範囲選択してユーザーに注意を促すとかでなけりゃSelect使う事に疑問を持った方がいい。 0698デフォルトの名無しさん (ﾜｯﾁｮｲ 6fe0-615/)2017/12/24(日) 06:22:03.30ID:ZKd7S1fn0 起動中のIEからさらに別窓で開かれるフォーム入力用窓のIEオブジェクトを取得して操作したいと考えているのですが、 Function hoge() As WebBrowser Dim tmp As Variant For Each tmp In CreateObject("Shell.Application").Windows If TypeName(tmp.document) = "HTMLDocument" Then Set hoge = tmp Exit Function End If Next tmp End Function のようにShellを使ってもIEオブジェクトを取得できなくて困っています
Set objIE = MAGIC(hWnd) のような形で、ハンドルからIEオブジェクトを取得する方法は無いでしょうか 他に方法があれば、ハンドルから取得する方法にこだわりません ただし、諸事情により外部からライブラリをダウンロードしてきて使用する、といったことはできないです 0699デフォルトの名無しさん (ﾜｯﾁｮｲ 93f7-vrKU)2017/12/24(日) 08:15:14.57ID:BN72T8jr0>>698 別窓かどうかの判定が抜けてる LocationNameとかLocationURLあたりを調べないと 0700デフォルトの名無しさん (ﾜｯﾁｮｲ 6f9f-WV/z)2017/12/24(日) 11:59:50.98ID:uwQxUsVy0 IEが複数あるかもしれないのに見つかったら抜けちゃうコードで何かおかしいと感じないの? 0701デフォルトの名無しさん (ﾜｯﾁｮｲ ff8a-EmoC)2017/12/24(日) 15:06:20.77ID:6Phr71Y20 Dim u As Long Range("A1", "I5").Value = u u = Round(u, 4)
Dim i As Long Dim Lrow As Long Lrow = Cells(Rows.Count, "A").End(xlUp).Row For i = 2 To Lrow Cells(i, "D").Formula = "=B2-C2" Next 0710デフォルトの名無しさん (ｱｰｸｾｰ Sx87-/hyL)2017/12/24(日) 16:09:57.86ID:U3mSSLWjx>>709 数式書き込んでるループ内の処理の右辺を "=$B" & i & "-" & "$C" & i にするだけ 折角行インデックスをiで指定してループ回してるんだから使わないと
この程度のことだったらVBA使わなくても組み込みのテーブル機能で実現できるけどね 0711デフォルトの名無しさん (ﾜｯﾁｮｲ cfb9-bqMz)2017/12/24(日) 16:11:04.02ID:O2udkTbW0>>709 Sub foo() Cells(2, 4).Formula = "= B2 - C2" Cells(2, 4).Copy Lrow = Cells(Rows.Count, 1).End(xlUp).Row Range(Cells(2, 4), Cells(Lrow, 4)).PasteSpecial End Sub 0712デフォルトの名無しさん (ﾜｯﾁｮｲ 03d2-oA/d)2017/12/24(日) 16:13:21.90ID:JTJf6bSC0>>710>>711
MsgBox(worksheets(1).range("B2:C3")(0).address) 0715デフォルトの名無しさん (ﾜｯﾁｮｲ 6fc5-buzn)2017/12/24(日) 21:16:40.55ID:ODr8GH0o0 0 じゃなく 1 0716デフォルトの名無しさん (ﾜｯﾁｮｲ ff23-9Igo)2017/12/24(日) 22:01:25.06ID:TDjZS1ex0>>715 ありがとうございます OffSet()だと原点がゼロなので そういうのと混同していたかも知れません 0717デフォルトの名無しさん (ﾜｯﾁｮｲ 03bd-EmoC)2017/12/24(日) 22:44:17.96ID:4FfGU/eI0 Dim FSO As Object Set FSO = CreateObject("scripting.filesystemobject") Dim folder As Object Set folder = FSO.getfolder(ファイルパス) Dim f As Object For Each f In folder.Files If f.Name Like "*" & Month(Date) & "*" Then ’ここでファイル名を翌月に変えてコピーを作成したい End If Next
ファイル名は「AAA〇〇月BBB」で統一(ABは文字列で〇〇は月を二桁表示) 抽出できた今月ファイルをコピーして名前の〇〇を翌月に変更したもの(翌月ファイル)を同フォルダ内に作成したいです コピー元ファイル名を継承して一部だけ変更する良い方法が見つからなかったので教えてください 0718デフォルトの名無しさん (ｱｳｱｳｶｰ Sac7-92zu)2017/12/24(日) 23:29:24.13ID:XB6s5ekxa>>712 そのセル全部のRangeに対して"=B2-C2"でいける。 0719デフォルトの名無しさん (ﾜｯﾁｮｲ cfb9-bqMz)2017/12/25(月) 00:16:31.32ID:2KDGjSox0>>717 Sub foo(FolderPath As String) Dim FSO As New FileSystemObject Dim c As New Collection Dim Folder As Folder Dim File As File
FindWord = "*" & Month(Date) & "*" Set Folder = FSO.GetFolder(FolderPath) For Each File In Folder.Files If File.Name Like FindWord Then Exit For Next If File Is Nothing Then Exit Sub
s = Split(File.Path, "\") For i = LBound(s) To UBound(s) If s(i) Like FindWord Then e = Split(s(i), ".") s(i) = Month(DateAdd("m", 1, Date)) & s(1) End If FilePath = FilePath & s(i) If i < UBound(s) Then FilePath = FilePath & "\" Next
仕方が無いので２の「戻る」に UserForm1.Show Unload Me と書いてみると、今度は１から２にもう一度行こうとすると、「フォームは既に表示されています。モーダルに表示できません」と出ます ついでにとにかくhideは避けてすべてunloadにしてもやはり２→１の段階で同じアラート 解決法はありますか？ 0728デフォルトの名無しさん (ﾜｯﾁｮｲ ffb3-7LW1)2017/12/25(月) 17:48:59.15ID:1470x9yD0>>726 ありがとうございます 調べてみます 分からなかったらまた書きますのでお願いします・・・ 0729デフォルトの名無しさん (ﾜｯﾁｮｲ ffb3-7LW1)2017/12/25(月) 18:01:10.24ID:1470x9yD0>>726 うまくいったようです 3時間ほど解決法が見つからず頭抱えてました 感謝です 0730デフォルトの名無しさん (ﾜｯﾁｮｲ 03bd-EmoC)2017/12/25(月) 22:53:06.92ID:S4ukHgvI0 sub test() 'マクロ起動用エクセルがあるフォルダ内のフォルダ名の取得 Dim strPattern As String Dim strFolder As String strPattern = "C:\xxxxx" strFolder = Dir(strPattern, vbDirectory)
Do While Len(strFolder) > 0 If GetAttr(strPattern & strFolder) And vbDirectory Then If strFolder <> "." And strFolder <> ".." Then 'if文始まり '各フォルダ内にあるエクセルファイル名の取得 Dim FSO As Object Set FSO = CreateObject("scripting.filesystemobject") Dim folder As Object Set folder = FSO.getfolder(strPattern & strFolder) Dim f As Object For Each f In folder.Files If f.Name Like "*" & Month(Date) & "*" Then 'ファイルパスに今月が含まれている場合 FSO.copyfile f.Path, folder.Path & "\" & Replace(f.Name, Month(Date), Month(DateAdd("m", 1, Date))) Debug.Print f.Name End If Next End If 'if文終わり End If strFolder = Dir() Loop End Sub
