人気マンガがだれでも無料♪電子コミック読み放題!!

VBAでIEを操作するマクロを作っています。

ホームページでCSVダウンロードボタンを押すと、添付図の様なダイアログが表示されます。
このダイアログで"ファイルを開く(o)"のボタンを押したいのですが、方法が分かりません。
Sendkeyで試しましたが不安定なため、別の方法がないか探していたところ、この教えてgooでタイトル「IE操作時、ファイルのダウンロードボタンの押下」を見つけました。

早速、そこのベストアンサーになっていたコードをコピーし、下記2か所のみ変更し組み込みました。①親ウィンドウ取得のstrCaptionを所定のページタイトル(shoene.org)に変更
②保存ボタンを見つけたらクリックするのaccName(CHILD_SELF)="ファイルを開く"に変更

しかしながら、コンパイルエラーとなり、実行できません。
VBA、IEとも初心者で内容詳細が分からず、エラーの修正箇所が分かりません。

コードを下記します。コンパイルエラーとなっている行番号は、下記です。
<エラー行番号>
1、12-14、15-17、18、30、36、39、40、42、49、50、58、62

間違っているところ、修正内容についてお教え願います。
ーーーーーーーーーーー以下コードーーーーーーーーーーーーーーーーーーーーーーーーー
行番号
1 Private Delegate Function D_EnumChildWindowsProc(ByVal hWnd As IntPtr, ByVal lParam As IntPtr) As IntPtr
2 Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As IntPtr, ByVal hWnd2 As IntPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As IntPtr
3 Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As IntPtr, ByVal wMsg As IntPtr, ByVal wParam As IntPtr, ByVal lParam As String) As IntPtr
4 Private Const WM_ACTIVATE = &H6
5 Private Const BM_CLICK = &HF5
6 Private Const WM_GETTEXT = &HD
7 Private Const WM_QUIT = &H10
8 Private Const NAVDIR_NEXT = &H5
9 Private Const NAVDIR_FIRSTCHILD = &H7
10 Private Const CHILDID_SELF = &H0
11 Private Const OBJID_CLIENT = &HFFFFFFFC
12 Private Declare Function AccessibleObjectFromWindow Lib "oleacc" _
13 (ByVal hWnd As IntPtr, ByVal dwId As IntPtr, _
14 ByRef riid As Guid, <MarshalAs(UnmanagedType.IUnknown)> ByRef ppvObject As Object) As IntPtr
15 Declare Function AccessibleChildren Lib "oleacc" _
16 (ByVal paccContainer As IAccessible, ByVal iChildStart As IntPtr,
17 ByVal cChildren As IntPtr, <[Out]()> ByVal rgvarChildren() As Object, ByRef pcObtained As IntPtr) As IntPtr
18 Private IID_IAccessible As Guid = New Guid(&H20400, 0, 0, {&HC0, 0, 0, 0, 0, 0, 0, &H46}
19
20 Sub FileDownLoad_Proc()
21 Dim strCaption As String
22 Dim PWnd As IntPtr
23 Dim cWnd As IntPtr
24
25 ' 親ウィンドウ取得
26 strCaption = "shoene.org"
27 While PWnd = 0
28 PWnd = FindWindowEx(0, 0, "IEFrame", strCaption)
29 System.Threading.Thread.Sleep (50)
30 End While
31
32 ' 通知バーのハンドル
33 While cWnd = 0
34 cWnd = FindWindowEx(PWnd, 0&, "Frame Notification Bar", vbNullString)
35 System.Threading.Thread.Sleep (50)
36 End While
37
38 ' 通知バーボタン群のハンドル
39 Dim hChild As IntPtr = FindWindowEx(cWnd, 0&, "DirectUIHWND", vbNullString)
40 Dim objAcc As IAccessible = Nothing
41
42 AccessibleObjectFromWindow(hChild, OBJID_CLIENT, IID_IAccessible, objAcc)
43
44 If Not IsNothing(objAcc) Then
45 ClickPreserve (objAcc)
46 While cWnd = 0
47 cWnd = FindWindowEx(PWnd, 0&, "Frame Notification Bar", vbNullString)
48 System.Threading.Thread.Sleep (50)
49 End While
50 SendMessage(cWnd, WM_QUIT, 0, 0&)
51
52 End If
53
54 End Sub
55 Private Sub ClickPreserve(ByVal acc As IAccessible)
56
57 Dim i As Long
58 Dim count = acc.accChildCount
59 Dim lst(Count - 1) As Object
60
61 If Count > 0 Then
62 AccessibleChildren(acc, 0, count, lst, 0)
63 If Not IsNothing(lst) Then
64 For i = LBound(lst) To UBound(lst)
65 With lst(i)
66 'On Error Resume Next
67 'Debug.Print("ChildCount: " & .accChildCount)
68 'Debug.Print("Value: " & .accValue(CHILDID_SELF))
69 'Debug.Print("Name: " & .accName(CHILDID_SELF))
70 'Debug.Print("Description: " & .accDescription(CHILDID_SELF))
71 'On Error GoTo 0
72 '保存ボタンを見つけたらクリック(デフォルトアクション)する
73 If .accName(CHILDID_SELF) = "ファイルを開く" Then
74
75 System.Threading.Thread.Sleep (500)
76 .accDoDefaultAction (CHILDID_SELF)
77 System.Threading.Thread.Sleep (500)
78 End If
79 End With
80 ClickPreserve (lst(i)) '再帰
81 Next
82 End If
83 End If
84 End Sub

「VBA IE操作でダイアログ表示後、ファ」の質問画像

A 回答 (1件)

>コンパイルエラーとなっている行番号は、下記です。



まず、行番号の使い方が違っていて、行番号はBasic の時代だけではありません。VB系の行番号は、エディタの行番号とは違います。VBのコードの行番号は、プログラムの書法のひとつです。Win32 API や dim の所には行番号は入れてはいけないのです。

今回の掲示のコードは、VBA のコードではありません。VB.Net のコードです。

次に、このような目的のコードは、緊急避難的なもので、時々、ダウンロード・ファィル名が、通知バーが出るまで分からないものがあります。そういう時に、力を発揮するもので、通常は使いません。
今、調べてみましたが、現在の通知バーではないようです。Spy++ (ファイル名:spyxx.exe -visual studio ??\Common7\Tools やVector の miniSpy.exe でも使っておなしてください。

◦通知バーを操作してファイルをダウンロードする方法
https://www.ka-net.org/blog/?p=4855#Notification …

hSaveAsDialog = FindWindowEx(0, 0, "#32770", "名前を付けて保存")

これと同等のUWSCがあるはずですから、Excel 等のVBAからUWSCを起動すれば済むはずです。
http://www.uwsc.info/
http://nymemo.com/uwsc/193/

もちろん、これを読み取って、それをVBAに移植は可能なはずです。
しかし、それ以上です。コードは信じられないほど簡単になっています。

>handle = GETCTLHND(id,"DirectUIHWND",2) ←通知バーの現在のハンドル
>ハンドルをIDに変換 id2 = HNDtoID(handle)
>保存ボタンを押す CLKITEM(id2, "保存", CLK_ACC)

単にやっていことは、これだけなのです。UWSC は、内部はWin APIの塊なのですが、すごいとしか言いようがないです。

私は、この手のコードは試したことがありません。通常、事前にダウンロード名が取れますので、後は、直接ダウンロードしてしまいます。ファイルを開くを押しても、インターネットキャッシュにてダウンロードして、展開するだけだと思います。
「VBA IE操作でダイアログ表示後、ファ」の回答画像1
    • good
    • 0
この回答へのお礼

早々に回答いただきありがとうございます。
Sendkeyで動作不安定だったため、調べて見つけたコードで試しましたが、この方法は「緊急避難的なもので通常使わない」ということですね。
教えていただいた別の方法”UWSCを使う方法”で再検討してみます。
また、教えていただきたいことが出てくると思いますが、その際にはまたご教示いただけると助かります。
ありがとうございました。

お礼日時:2017/07/04 09:35

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aと関連する良く見られている質問

QIE操作時、ファイルのダウンロードボタンの押下

IEをvb.netから操作しています。
webからファイルのダウンロードを自動で行いたいのですが、どのようにすればいいのかわからず悩んでいます。

画像の赤枠で括ってあるボタンの押下を、vb.netからの操作で行いたいのですが、どのようにすれば良いでしょうか。
InternetExplorer.Applicationに何らかのメンバ関数のようなものがあるのか、sendkeysを使うしかないのか、sendkeysを使うなら、具体的にどのキー操作を送れば良いのかなど、お教えいただけないでしょうか。

よろしくお願いします!

Aベストアンサー

Windows7 IE9ですが、↓で動きました

Private Delegate Function D_EnumChildWindowsProc(ByVal hWnd As IntPtr, ByVal lParam As IntPtr) As IntPtr

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As IntPtr, ByVal hWnd2 As IntPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As IntPtr
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As IntPtr, ByVal wParam As IntPtr, ByVal lParam As String) As IntPtr

Private Const WM_ACTIVATE = &H6
Private Const BM_CLICK = &HF5
Private Const WM_GETTEXT = &HD
Private Const WM_QUIT = &H10

Private Const NAVDIR_NEXT = &H5
Private Const NAVDIR_FIRSTCHILD = &H7
Private Const CHILDID_SELF = &H0
Private Const OBJID_CLIENT = &HFFFFFFFC

Private Declare Function AccessibleObjectFromWindow Lib "oleacc" _
(ByVal hWnd As IntPtr, ByVal dwId As IntPtr, _
ByRef riid As Guid, <MarshalAs(UnmanagedType.IUnknown)> ByRef ppvObject As Object) As IntPtr
Declare Function AccessibleChildren Lib "oleacc" _
(ByVal paccContainer As IAccessible, ByVal iChildStart As IntPtr,
ByVal cChildren As IntPtr, <[Out]()> ByVal rgvarChildren() As Object, ByRef pcObtained As IntPtr) As IntPtr

Private IID_IAccessible As Guid = New Guid(&H20400, 0, 0, {&HC0, 0, 0, 0, 0, 0, 0, &H46})

Sub FileDownLoad_Proc()
Dim strCaption As String
Dim PWnd As IntPtr
Dim cWnd As IntPtr

' 親ウィンドウ取得
strCaption = "○○○○ - Windows Internet Explorer"
While PWnd = 0
PWnd = FindWindowEx(0, 0, "IEFrame", strCaption)
System.Threading.Thread.Sleep(50)
End While

' 通知バーのハンドル
While cWnd = 0
cWnd = FindWindowEx(PWnd, 0&, "Frame Notification Bar", vbNullString)
System.Threading.Thread.Sleep(50)
End While

' 通知バーボタン群のハンドル
Dim hChild As IntPtr = FindWindowEx(cWnd, 0&, "DirectUIHWND", vbNullString)
Dim objAcc As IAccessible = Nothing

AccessibleObjectFromWindow(hChild, OBJID_CLIENT, IID_IAccessible, objAcc)

If Not IsNothing(objAcc) Then
ClickPreserve(objAcc)
While cWnd = 0
cWnd = FindWindowEx(PWnd, 0&, "Frame Notification Bar", vbNullString)
System.Threading.Thread.Sleep(50)
End While
SendMessage(cWnd, WM_QUIT, 0, 0&)

End If

End Sub
Private Sub ClickPreserve(ByVal acc As IAccessible)

Dim i As Long
Dim count = acc.accChildCount
Dim lst(count - 1) As Object

If count > 0 Then
AccessibleChildren(acc, 0, count, lst, 0)
If Not IsNothing(lst) Then
For i = LBound(lst) To UBound(lst)
With lst(i)
'On Error Resume Next
'Debug.Print("ChildCount: " & .accChildCount)
'Debug.Print("Value: " & .accValue(CHILDID_SELF))
'Debug.Print("Name: " & .accName(CHILDID_SELF))
'Debug.Print("Description: " & .accDescription(CHILDID_SELF))
'On Error GoTo 0
'保存ボタンを見つけたらクリック(デフォルトアクション)する
If .accName(CHILDID_SELF) = "保存" Then

System.Threading.Thread.Sleep(500)
.accDoDefaultAction(CHILDID_SELF)
System.Threading.Thread.Sleep(500)
End If
End With
ClickPreserve(lst(i)) '再帰
Next
End If
End If
End Sub

Windows7 IE9ですが、↓で動きました

Private Delegate Function D_EnumChildWindowsProc(ByVal hWnd As IntPtr, ByVal lParam As IntPtr) As IntPtr

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As IntPtr, ByVal hWnd2 As IntPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As IntPtr
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As IntPtr, ByVal wParam As IntPtr, ByVal lP...続きを読む

QVBAからIEを操作する時のウィンドウの選択の仕方がわかりません

VBAで、webページを操作するマクロを組んでいます。
具体的な手順としては、セルの商品番号をweb上の検索ボックスに入力して、別ウィンドウで開いた情報を「すべて選択」「コピー」してexcellの別シートに「貼り付け」までを行うものなのですが、
別ウィンドウで開いたページに対して、Sendkeysを行うにはどうやったらいいのでしょうか。
仮に、入力ページをA、結果ページをBとしたとき、Aに対しての入力とBページの表示までは出来ているのですが、Bページに対しての操作が出来ません。

ちなみに、事情があってwebクエリはあえて使っていません。
どなたか、いい解決方法・プロシージャをご存知でしたらよろしくお願いします。

Aベストアンサー

こんにちは。KenKen_SP です。

検索フォーム経由ではなく、検索結果のページをコードで直接開けないですか?
例えば、教えてGooなら

http://oshiete1.goo.ne.jp/kotaeru.php3?q=


URL の後ろに ? マークがあります。この記号以下は CGI に渡すパラメータです。
q= の後ろに質問番号が入りますので、予め質問番号が分かっている場合は、
この URL に質問番号を連結してやれば、直接開くことができます。

仮に、質問番号が A1 セルに入っているなら

IE.Navigate "http://oshiete1.goo.ne.jp/kotaeru.php3?q=" & Range("A1").Value

みたいなコードで検索結果ページを開くことができると思います。同様に、商品番号
を渡すパラメータがあるはずですから、探して見て下さい。CGI にパラメータを渡す
方法が Get でも Post の場合でも検索フォームの HTML ソースを見れば分かります。

取り合えず、一度検索フォームの HTML ソースを見てみましょう。

これが可能なら、コードで IE オブジェクトを作り、直接検索結果のページを開くこ
とができますので、IE のウインドウハンドルやウインドウタイトルは簡単に取得
できます。

簡単な例です。A1 セルの値を Google で検索し、結果を A5 セルに貼り付けます。


Option Explicit

Private Declare Function SetForegroundWindow Lib "user32.dll" ( _
  ByVal hWnd As Long _
) As Long
  
Sub Sample()

  Dim IE   As Object
  Dim strURL As String
  Dim lngRet As Long
  
  Const READYSTATE_COMPLETE = &H4
  
  strURL = "http://www.google.com/search?hl=ja&lr=lang_ja&ie=Shift_JIS&q="
  strURL = strURL & Range("A1").Value
   
  Set IE = CreateObject("InternetExplorer.application")
  IE.Visible = True
  IE.navigate strURL
  Do
    DoEvents
  Loop Until Not IE.Busy And IE.readyState = READYSTATE_COMPLETE
  
  ' IE のウインドウをアクティブにする
  lngRet = SetForegroundWindow(IE.hWnd)
  If lngRet <> 0 Then
    ' アクティブにできたらキー送信して結果をコピー
    SendKeys "^a", True
    SendKeys "^c", True
    ' 貼り付け
    Range("A5").Select
    ActiveSheet.Paste
  End If
  Set IE = Nothing

End Sub

どうしても検索フォームを経由し、新しい IE を開く必要がある場合は、
参考 URL 先の記事が参考になると思います。

参考 URL: http://www.ken3.org/cgi-bin/group/vba_ie.asp

ちなみに、SendKeys を使わない方法としては、IE.Document.body.innerHTML
で HTML ソースは取得し、クリップボードに転送してからペースト、、

というのでも良いかもしれません。

では。

こんにちは。KenKen_SP です。

検索フォーム経由ではなく、検索結果のページをコードで直接開けないですか?
例えば、教えてGooなら

http://oshiete1.goo.ne.jp/kotaeru.php3?q=


URL の後ろに ? マークがあります。この記号以下は CGI に渡すパラメータです。
q= の後ろに質問番号が入りますので、予め質問番号が分かっている場合は、
この URL に質問番号を連結してやれば、直接開くことができます。

仮に、質問番号が A1 セルに入っているなら

IE.Navigate "http://oshiete1.goo.ne.jp/kot...続きを読む

QVBAを使い、Web上からファイルをダウンロードしたいのですが・・・

はじめまして。
今、日証金から日々の融資・貸株残高のデータ(CSV)を自動的に
ダウンロードしてExcelに取り込むというマクロを作ろうとして
いるのですが、うまくいきません。


具体的には、

range("A1").value = "http://www.jsf.co.jp/de/stock/dlcsv.php?target=balance&date=" & format(now,"YYYY-MM-DD")
range("A1").select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True

しかし、これだと「ファイルを保存」のWindowがあがってしまうので
処理が途中で止まります。

VBAで、あらかじめ指定したディレクトリに、指定したURLからファイルを自動的にダウンロードする
には、どのようにすればよいのでしょうか?

Aベストアンサー

ちょっと無茶ですね・・・。
APIという機能を使う事になります。
これでVBAの機能を拡張して新たな機能を取り込む事ができるようになります。


http://www.accessclub.jp/bbs5/0009/vba2406.html
http://www.ken3.org/vba/backno/vba120.html

QIEのダウンロード通知バーのVBA制御(保存他)

以前投稿された表題の質問をマネしてVBAから通知バーの制御を試みたらエラーになりました。
原因がわからず困っています。どこに問題があるか教えて頂けないでしょうか?
http://okwave.jp/qa/q8121989.html
■実行エラー91
「オブジェクト変数またはWithブロック変数が設定されていません」
■エラー停止箇所
Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
■補足
・参照設定はしています。
・下記2点に示すようにお尻の数字を削除しています。(他のエラーがでてしまうため)
  Dim o As IUIAutomation2→IUIAutomation
  Set o = New CUIAutomation8→CUIAutomation

---【http://okwave.jp/qa/q8121989.html】------------------------------------------------------
Option Explicit
'参照設定 UIAutomationClient
'C:\Windows\System32\UIAutomationCore.dll
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr

Sub hoge2()

Const url As String = ""
Dim ie As Object
Set ie = CreateObject("Shell.Application").Windows.findwindowSW(url, Empty, 1, 0, 1)
If ie Is Nothing Then Exit Sub

Dim o As IUIAutomation2
Dim e As IUIAutomationElement
Set o = New CUIAutomation8
Dim h As LongPtr

h = ie.Hwnd
h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)
If h = 0 Then Exit Sub
Set e = o.ElementFromHandle(ByVal h)

Dim iCnd As IUIAutomationCondition
Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "保存")

Dim Button As IUIAutomationElement
Set Button = e.FindFirst(TreeScope_Subtree, iCnd)

Dim InvokePattern As IUIAutomationInvokePattern
Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
InvokePattern.Invoke

DoEvents
Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "通知バーのテキスト")
Dim iElemFound As IUIAutomationElement
Set iElemFound = e.FindFirst(TreeScope_Subtree, iCnd)
Dim iValuePattern As IUIAutomationValuePattern
Set iValuePattern = iElemFound.GetCurrentPattern(UIA_ValuePatternId)

Do
DoEvents
If iValuePattern.CurrentValue Like "*のダウンロードが完了しました。*" Then
Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "閉じる")
Set iElemFound = e.FindFirst(TreeScope_Subtree, iCnd)
Set InvokePattern = iElemFound.GetCurrentPattern(UIA_InvokePatternId)
InvokePattern.Invoke
Exit Do
End If
Loop

End Sub

以前投稿された表題の質問をマネしてVBAから通知バーの制御を試みたらエラーになりました。
原因がわからず困っています。どこに問題があるか教えて頂けないでしょうか?
http://okwave.jp/qa/q8121989.html
■実行エラー91
「オブジェクト変数またはWithブロック変数が設定されていません」
■エラー停止箇所
Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
■補足
・参照設定はしています。
・下記2点に示すようにお尻の数字を削除しています。(他のエラーがでてしまうため)
...続きを読む

Aベストアンサー

そのコードは通知バーが完全に表示されている状態での実行を期待しています。
なので、ループで参照がセット出来るまで、待ち合わせてみるとか。

Dim Button As IUIAutomationElement
Dim InvokePattern As IUIAutomationInvokePattern

While Not InvokePattern Is Nothing
DoEvents
Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
Wend
InvokePattern.Invoke

QIEのダウンロード通知バーVBA制御

下記URLを参考にUIAutomationClientを利用して通知バーを制御していますが、通知バーはでているのにボタン取得に失敗しやすいです。
また、分割の名前を付けて保存
http://okwave.jp/qa/q8121989.html
基本的にSetの箇所にDo while オブジェクト is nothingを入れて確実に取得できるようにしました。しかし、そうすると取得までに時間がかかる場合があります。時間短縮の方法をアドバイス頂きたいのがこの度の趣旨になります。

具体的にはダウンロード時に名前を付けて保存をしたいのですが、例えば保存バーがでているのにドロップボタンを押すまで時間がかかる。また、ドロップボタンは押せているのに名前を付けて保存をなかなかすぐに押してくれないといった感じです。またその後の保存ダイアログでも同様に、表示されているのになかなか押してくれないといった状況です。
やはり、オブジェクトの取得がうまくできていないためWhileでぐるぐると取得するのに時間を費やしているようでした。どのようにすれば時間短縮ができるかアドバイス頂けると助かります。回答でなくても、これやってみたら?みたいな感じでアドバイス頂けると助かります。
宜しくおねがいします。

下記URLを参考にUIAutomationClientを利用して通知バーを制御していますが、通知バーはでているのにボタン取得に失敗しやすいです。
また、分割の名前を付けて保存
http://okwave.jp/qa/q8121989.html
基本的にSetの箇所にDo while オブジェクト is nothingを入れて確実に取得できるようにしました。しかし、そうすると取得までに時間がかかる場合があります。時間短縮の方法をアドバイス頂きたいのがこの度の趣旨になります。

具体的にはダウンロード時に名前を付けて保存をしたいのですが、例えば保存バ...続きを読む

Aベストアンサー

IE制御に於いてループ中のDoEventsは遅延を招くそうで、Sleepに置き換えるとか。

(ネットワークタブでキャプチャすれば)
後は、F12Chooser.exeを制御してダイアログや通知バーが表示されるタイミングで、ファイルへのアドレスが分かるので、
(UI Automation辺りで)

XMLHTTPとADODB.Streamの組み合わせでダウンロードするとか、ぐらいですかね。

QVBA 印刷範囲の設定方法

お久しぶりでございます。
自己流でVBAを記述したんですが、うまく動作が確認できません。
ご指摘いただけると助かります。

現状
accessデータベースより、エクセルに条件抽出したデータでテーブルを作りました。
現在VBAコードにて、テーブルの更新があった際
テーブルの行数に応じて、別シートの印刷範囲を設定したいと考えているのですがうまくいきません。

1つのページに、1つの会社情報が記入できる書式があり
sheet"参照データ"から、会社情報をsheet"会社情報"・sheet"通知書"の書式の中の該当する欄にデータを飛ばしています。


記述場所は、shhet"参照データ”にしております。
Private Sub Worksheet_TableUpdate(ByVal Target As TableObject)
Dim sh As Worksheet
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim IH As Long

Set sh = Worksheet("参照データ")
Set sh1 = Worksheet("会社情報")
Set sh2 = Worksheet("通知書")

IH = Application.WorksheetFunction.CountA(Range("B2, .end(xlup)"))



sh1.PageSetup.PrintArea = "A1:AX" & IH * 62

sh2.PageSetup.PrintArea = "A1:AQ" & IH * 43


End Sub

お久しぶりでございます。
自己流でVBAを記述したんですが、うまく動作が確認できません。
ご指摘いただけると助かります。

現状
accessデータベースより、エクセルに条件抽出したデータでテーブルを作りました。
現在VBAコードにて、テーブルの更新があった際
テーブルの行数に応じて、別シートの印刷範囲を設定したいと考えているのですがうまくいきません。

1つのページに、1つの会社情報が記入できる書式があり
sheet"参照データ"から、会社情報をsheet"会社情報"・sheet"通知書"の書式の...続きを読む

Aベストアンサー

こんにちは。

IH = Application.WorksheetFunction.CountA(Range("B2, .end(xlup)"))

これは、ありえませんね。
厳密に書けばこういうことになるとは思います。普通はアクティブシートで最後のセルを取得するので、With Sh などや、「.(コンマ)」は省略してしまいますが。

With Sh
  IH = WorksheetFunction.CountA(.Range("B2", .Cells(Rows.Count, 2).End(xlUp)))
End With

'--continue the next codes--
'------------------

ただ、CountA で取るというのは、大丈夫なのかなとは思います。

Q画面に表示されたファイル選択ダイアログに対して、ファイル指定のみ自動化したい

ファイル選択ダイアログが画面上に出てきた際、いつも決まったフォルダ内の全ファイルをアップロードしているので、ファイルアップロード部分のみ、バッチやVBSにてクリックするだけでファイルをアップロードするというものを作りたいのですが、全くの初心者で、ファイル選択ダイアログから作るという情報しか出ないため、どなたか、教えて頂けますでしょうか。

Aベストアンサー

cmd変数にcurlで利用可能なパラメータをつけた文字列を投入しています
パラメータについてはcurlの仕様をマニュアルなどで確認してください

その後 WshShell.Runでcmdを実行することにより、
windowsのコマンドプロンプトで実行するのと同じような効果が得られます

QVBA 別ブックにワークシートをコピーする

Sub 別ブックのシートコピー()
Dim SA_MV1 As String
Dim MV2 As String
Worksheets("SA_MV1").Copy After:=Workbooks("Schedule.xls").Sheets(MV2)
End Sub

上記を実行すると、実行時エラー'9'
インデックスが有効範囲にありません。
というエラーが出ます。

何がいけないのでしょうか。どなたかアドバイスいただけますと助かります。
よろしくお願いします。

Aベストアンサー

>コピー先のブックにSA_MV1という名前のシートを作成した状態で、実行すると

マクロのあるブックと、コピー元・コピー先の関係が理解出来ていないようですね。
きちんと確実に動作させるには、ブック名を正しく指定してプログラミングを行う必要があります。

ブック名を指定せずに Worksheets("Sheet1").~ と書いた場合は、マクロのあるブックのシート名を指定した事になります。
A.xls にマクロが記載されていてそれを実行しても、B.xls のシートを指定した事にはなりません。

Workbooks("B.xls").Worksheets("Sheet4").Copy After:=Workbooks("A.xls").Sheets("Sheet3")

QVBA コンパイルエラーの解消法

皆様、いつもお世話になっております。
初心者なりに考えてVBAを組んでみたのですが、「Sub または Fanction が定義されていません」とエラー表示が出てきます。
自分なりにコードに間違いがないか検索ながらやってみたのですが、うまくいきません。

どなたか、知恵をお貸しいただけないでしょうか。



テーブルの入っているSheet1から、シート”施工体制台帳~”の該当するセルにデータのコピーを行うためのVBAです。
業者の数だけループするように組んだつもりなのですが、エラー表示のため実行ができません。
ご指摘、よろしくお願いいたします。

Sub kopipe1() '施工体制台帳
Dim sh As Worksheet
Dim sh1 As Worksheet
Dim sb As Long
Dim m As Long
Dim p As Long
Dim c As Long
Dim i As Long
Dim end1 As Long

Set sh = Worksheet("sheet1")
Set sh1 = Worksheet("施工体制台帳 (下請け) ")


end1 = sh.Range(".Cells(Rows.Count, 2)").End(xlUp)
sb = 1
p = 1

For i = 2 To end1 Step 1
sb = sb + 1
c = cell(p, 9)

sh.cell(sb, 2).Copy Destination:=.sh1.Range(c).Offset(2, 1) '会社名
sh.cell(sb, 3).Copy Destination:=.sh1.Range(c).Offset(2, 27) '代表者名
sh.cell(sb, 4).Copy Destination:=.sh1.Range(c).Offset(4, 1) '郵便番号
sh.cell(sb, 5).Copy Destination:=.sh1.Range(c).Offset(5, 1) '住所
sh.cell(sb, 6).Copy Destination:=.sh1.Range(c).Offset(6, 24) '電話番号
sh.cell(sb, 7).Copy Destination:=.sh1.Range(c).Offset(13) '業種1
sh.cell(sb, 8).Copy Destination:=.sh1.Range(c).Offset(14, 12) '許可者1
sh.cell(sb, 9).Copy Destination:=.sh1.Range(c).Offset(14, 15) '区分1
sh.cell(sb, 10).Copy Destination:=.sh1.Range(c).Offset(14, 17) '許可1-1
sh.cell(sb, 11).Copy Destination:=.sh1.Range(c).Offset(14, 20) '許可1-2
sh.cell(sb, 12).Copy Destination:=.sh1.Range(c).Offset(14, 27) '許可年月日
sh.cell(sb, 13).Copy Destination:=.sh1.Range(c).Offset(16) '業種2
sh.cell(sb, 14).Copy Destination:=.sh1.Range(c).Offset(17, 12) '許可者2
sh.cell(sb, 15).Copy Destination:=.sh1.Range(c).Offset(17, 15) '区分2
sh.cell(sb, 16).Copy Destination:=.sh1.Range(c).Offset(17, 17) '許可2-1
sh.cell(sb, 17).Copy Destination:=.sh1.Range(c).Offset(17, 20) '許可2-2
sh.cell(sb, 18).Copy Destination:=.sh1.Range(c).Offset(17, 27) '許可年月日2
sh.cell(sb, 19).Copy Destination:=.sh1.Range(c).Offset(21, 28) '健康保険
sh.cell(sb, 20).Copy Destination:=.sh1.Range(c).Offset(22, 28) '厚生年金保険
sh.cell(sb, 21).Copy Destination:=.sh1.Range(c).Offset(23, 28) '雇用保険
sh.cell(sb, 22).Copy Destination:=.sh1.Range(c).Offset(25, 3) '現場代理人指名
sh.cell(sb, 23).Copy Destination:=.sh1.Range(c).Offset(29, 7) '主任技術者氏名
sh.cell(sb, 24).Copy Destination:=.sh1.Range(c).Offset(31, 3) '資格内容
sh.cell(sb, 25).Copy Destination:=.sh1.Range(c).Offset(33, 3) '安全衛生責任者
sh.cell(sb, 26).Copy Destination:=.sh1.Range(c).Offset(25, 26) '安全衛生推進者
sh.cell(sb, 27).Copy Destination:=.sh1.Range(c).Offset(27, 26) '雇用管理責任者
sh.cell(sb, 28).Copy Destination:=.sh1.Range(c).Offset(29, 26) '専門技術者名
sh.cell(sb, 29).Copy Destination:=.sh1.Range(c).Offset(31, 26) '技術資格内容

p = p + 62
Exit For
Next i
End Sub

皆様、いつもお世話になっております。
初心者なりに考えてVBAを組んでみたのですが、「Sub または Fanction が定義されていません」とエラー表示が出てきます。
自分なりにコードに間違いがないか検索ながらやってみたのですが、うまくいきません。

どなたか、知恵をお貸しいただけないでしょうか。



テーブルの入っているSheet1から、シート”施工体制台帳~”の該当するセルにデータのコピーを行うためのVBAです。
業者の数だけループするように組んだつもりなのですが、エラー表示...続きを読む

Aベストアンサー

今のところ、変数に代入する以外のコードはほとんど間違っているわけですから、どれがどうと言えないと思います。
他の方との重複を含みます。
・Worksheet(---) ->Worksheets(----)
・sh.Range(".Cells(Rows.Count, 2)").End(xlUp)
  ↓
sh.Cells(Rows.Count, 2).End(xlUp).Row
・c = cell(p, 9)
  ↓
 c = Cells(p, 9) ただし、最後に、p = p + 62の後、Exit For では、1回キリでおしまいになってしまいます。

おそらくは、Dim c As String --Cells(p, 9).Address(0,0)
のはずです。
 
・sh.cell(sb, 2).Copy Destination:=.sh1.Range(c).Offset(2, 1) '会社名
とりあえず、Cells と sh1 のコンマは取るけれども、
sh1.Range(c).Offset(2, 1) これでは可読性を落とすばかりで分かりません。

これ自体を直すよりは、最初から作り直したほうが早そうです。
たぶん、一覧で横に並んでいるものを、別のシートの各場所に振り替えていくわけで、それが、ページごとになっているというわけでしょう。

まず、 sh1.cells(sb, 2).Copy ですが、
その列の2 を変数にすべきですね。

受ける側が、Offset で書かれてしまうと、手がつけられなくなってしまいます。

sh1.Range("J3,AJ3,J5,J6,AG7,I14,U15,X15,Z15,AC15,AJ15,I17," & _
 "U18,X18,Z18,AC18,AJ18,AK22,AK23,AK24,L26,P30,L32,L34," & _
 "AI26,AI28,AI30,AI32")

このようにまとめてしまい、以下のように纏めたものから呼び出すようにします。
しかし、実際にやってみると不具合が生じるので、それを配列で渡すようにします。

注:以下は、私の想像で書かれたものであって、実際に合っているのかは分かりません。
このようなスタイルにしてみたらという、あくでもこちらの提案です。

'//
Sub Test1()
 Dim Rng As Range
 Dim i As Long, j As Long, sb As Long
 Dim c As Variant
 Dim sh As Worksheet, sh1 As Worksheet
 Set sh = Worksheets("sheet1")
 Set sh1 = Worksheets("施工体制台帳 (下請け)")

 
 Set Rng = sh1.Range("J3,AJ3,J5,J6,AG7,I14,U15,X15,Z15,AC15,AJ15,I17," & _
 "U18,X18,Z18,AC18,AJ18,AK22,AK23,AK24,L26,P30,L32,L34," & _
 "AI26,AI28,AI30,AI32")
 
 end1 = sh.Cells(Rows.Count, 2).End(xlUp).row
 
 i = 2
 sb = 2
 For j = 1 To end1
 a = (j - 1) * 62 + 1
  For Each c In Rng.Offset((j - 1) * 62 + 1)
   c.Value = sh.Cells(sb, i).Value
   DoEvents
   i = i + 1
  Next
  i = 2
  sb = sb + 1
 Next
End Sub

今のところ、変数に代入する以外のコードはほとんど間違っているわけですから、どれがどうと言えないと思います。
他の方との重複を含みます。
・Worksheet(---) ->Worksheets(----)
・sh.Range(".Cells(Rows.Count, 2)").End(xlUp)
  ↓
sh.Cells(Rows.Count, 2).End(xlUp).Row
・c = cell(p, 9)
  ↓
 c = Cells(p, 9) ただし、最後に、p = p + 62の後、Exit For では、1回キリでおしまいになってしまいます。

おそらくは、Dim c As String --Cells(p, 9).Address(0,0)
のはずです。
 
・sh.cell(sb, 2).C...続きを読む

QvbaでIEの名前を付けて保存(A)をしたい

VBA で IEの通知バー を操作したいです。
SendKeys で 通知バーの 保存(S) はできたのですが、
保存(s)の右隣の ▼ をクリックするとでてくる、 名前を付けて保存(A) の方法がわかりません。

どのようなキーをおくればよいのでしょうか。


他の質問をみると、SendKeysではなく ○○がよいですよ みたいな内容しか見つからず、
回答をみつけることができなくて困っておりますのでよろしくお願いいたします。

Aベストアンサー

VBAでインターネット上のファイルをダウンロードする方法をまとめてみました。 | 初心者備忘録
http://www.ka-net.org/blog/?p=4855
とか。


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング