Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


28837 / 76732 ←次へ | 前へ→

【53185】Re:2つのファイルのマクロの同時実行
発言  ichinose  - 07/12/18(火) 21:27 -

引用なし
パスワード
   こんばんは。

VBSとVBAを組み合わせてみました。


>
>ブックを二つ用意します。
>
>1のブック dsptime.xls
> 機能 ユーザーフォームに時間経過を表示する機能を持つ
>
>2のブック setcell.xls
> 機能 setcell.xlsの最左端シートのA列に1から20000までの数値を書き込む
>    
3VBSスクリプト vbstest.vbs
  機能 setcell.xlsの最左端シートのA列に1から20000までの数値を書き込む時間を     計測し、setcell.xlsの最左端シートのセルB1処理時間を出力する  

>
>dsptime.xls
>
>ユーザーフォーム(Userform1)を一つ用意してください。
>  このUserform1には、
>     Label1 開始時間の表示
>     Label2 現在の時間を表示
>  という二つのラベルを用意してください。
>
>  ふたつのラベルには、hh:mm:ss形式で時刻を表示しますので、それに
>  足りうる幅をラベルは有します。
>
>コードです。
>
>
>Thisworkbookのモジュールに

Option Explicit
Public 時間 As Date
Sub set_proc()
  Application.OnTime Now(), "thisworkbook.dspform"
End Sub
'==================================================================
Sub dspform()
  UserForm1.Show
End Sub
'==================================================================
Sub unloadform()
'  Userform1の消去
  Unload UserForm1
End Sub
'==================================================================
Sub hideform()
'  時間表示を停止する
  UserForm1.dsp = False
End Sub
'==================================================================
Sub set_tm(rng As Range)
'  開始から、停止までの時間を指定されたセルに設定する
  rng.Value = 時間
End Sub

>
Userform1のモジュールは、ちょっと変更。
>'===================================================================
Option Explicit
Public dsp As Boolean
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, _
ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Const temae_set = -1
Const hyoji = &H40
Const nonesz = &H1
Const nonemv = &H2
'===================================================================
Private Sub UserForm_Activate()
  Dim hwnd As Long, ret As Long
  hwnd = FindWindow("ThunderDFrame", Me.Caption)
  ret = SetWindowPos(hwnd, temae_set, 0, _
     0, 0, 0, hyoji Or nonemv Or nonesz)
  dsp = True
  Label1.Caption = Format([now()], "hh:mm:ss")
  Do While dsp = True
    Label2.Caption = Format([now()], "hh:mm:ss")
    DoEvents
    Sleep 300
    Loop
  ThisWorkbook.時間 = CDate(Label2.Caption) - CDate(Label1.Caption)
  Me.Hide
End Sub
'===================================================================
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  If CloseMode <> 1 Then
    Cancel = True
    End If
End Sub


>setcell.xlsのコード
標準モジュールから、Thisworkbookのモジュールに変更

'=====================================================================
Option Explicit
Sub set_cell()
  Dim g0 As Long
  ThisWorkbook.Activate
  Worksheets(1).Activate
  Range("a:a").ClearContents
  For g0 = 1 To 20000
    With Cells(g0, 1)
     .Select
     .Value = g0
     End With
    Next
End Sub


最後にvbstest.vbsのコード
'=====================================================================
Dim g0 ,ex,dbk,fs
set fs=createobject("scripting.filesystemobject")
with CreateObject("excel.application")
  .visible=true 
  with .workbooks.Open(fs.GetParentFolderName(wscript.scriptfullname) & "\setcell.xls")
    Set ex = CreateObject("excel.application")
    Set dbk = ex.Workbooks.Open(fs.GetParentFolderName(wscript.scriptfullname) & "\dsptime.xls")
    dbk.set_proc
    .set_cell
    .worksheets(1).Range("b1").NumberFormatLocal = "hh:mm:ss"
    dbk.hideform
    dbk.set_tm .worksheets(1).Range("b1")
    dbk.unloadform
    dbk.Close False
    ex.Quit
    end with
  end with    
set ex=nothing
set dbk=nothing
set fs=nothing


>
上記のブックとVBSスクリプトを全て同じフォルダ上に保存した後、
vbstest.vbsを実行してみてください。
尚、この投稿からコピーする場合は、VBSコードの

  .visible=true 

頭の空白が全角になっているので、半角に修正して保存しなければならないので
注意が必要です(全角のままだとエラーになります)

この手のことを実現するには、結構、工夫が必要ですね!!

試してみてください。
(この場合は、時間表示のユーザーフォームが非アクティブにしても
 時間は、正常に取得できました)
1 hits

【53100】2つのファイルのマクロの同時実行 yhar 07/12/14(金) 16:47 質問
【53104】Re:2つのファイルのマクロの同時実行 ichinose 07/12/15(土) 9:36 発言
【53142】Re:2つのファイルのマクロの同時実行 yhar 07/12/17(月) 11:19 質問
【53149】Re:2つのファイルのマクロの同時実行 yhar 07/12/17(月) 17:22 質問
【53159】Re:2つのファイルのマクロの同時実行 ichinose 07/12/17(月) 21:55 発言
【53166】Re:2つのファイルのマクロの同時実行 一... ichinose 07/12/18(火) 7:41 発言
【53168】Re:2つのファイルのマクロの同時実行 追伸 ichinose 07/12/18(火) 8:28 発言
【53169】★まずは御礼★ 追伸 yhar 07/12/18(火) 8:45 お礼
【53185】Re:2つのファイルのマクロの同時実行 ichinose 07/12/18(火) 21:27 発言
【53430】【御礼】2つのファイルのマクロの同時実行 yhar 08/1/10(木) 16:55 お礼
【53143】Re:2つのファイルのマクロの同時実行 Who Me? 07/12/17(月) 11:34 発言
【53144】Re:2つのファイルのマクロの同時実行 yhar 07/12/17(月) 13:44 お礼

28837 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free