下記のVBAでExcel2003では出来たのですが、Excel2010ではエラーになります。
Excel2003と同じような動作をExcel2010で行いたいのですが、どこをどのように変えたら使用できるようになるでしょうか?
ネットで調べても初心者なもので全くわかりません。
Userform1に作成しているチェックボックスを選択すると、そのチェックボックスに対するドライブからファイルが検索される仕様になってます。
説明が下手で申し訳ありませんが、よろしくお願いします。


Private Sub CommandButton1_Click()

Set FSO = CreateObject("Scripting.FileSystemObject")

For x = 1 To 17
If Me.Controls("CheckBox" & x) = True Then Exit For 'チェックしてあるかを確認
If x = 18 Then Exit Sub
Next x

buf = InputBox("検索したいファイル名を入力してください" & vbCrLf & "ただし、複数キーワード検索はできません" & vbCrLf & "キーワード入力後、「OK」ボタンを選択", "キーワード入力")
If buf = "" Or buf = "False" Then Exit Sub

For x = 1 To 17

If Me.Controls("CheckBox" & x) = True Then
ドライブ = Chr(Asc("J") + x - 1)
Sheets(x + 1).Visible = True
Sheets(x + 1).Select
Cells(1, 1).Select

With Application.FileSearch
.NewSearch
.LookIn = ドライブ & ":\"
.Filename = buf
.SearchSubFolders = True
If .Execute() > 0 Then
MsgBox .FoundFiles.Count & " 個のファイルが見つかりました", vbOKOnly, "検索結果"

b = 1
Application.ScreenUpdating = False

For Each f In .FoundFiles
a = Range("C65536").End(xlUp).Row + 1
Cells(a, 2) = b
Cells(a, 3) = FSO.getfile(f).Name
Cells(a, 4) = FSO.getfile(f).DateLastModified
Cells(a, 5) = FSO.getfile(f).Path
b = b + 1
Next f

Else
MsgBox "見つかりませんでした"
Sheets(x + 1).Visible = False
End If
End With

For i = 5 To a Step 1

Cells(i, 3).Select

With ActiveSheet
.Hyperlinks.Add Anchor:=Selection, Address:=Cells(i, 5).Value

End With

Next i

If Range("E5") = "" Then
End
Else
Range(Cells(5, 5), Cells(a, 5)).Clear
End If

End If

Next x

Set FSO = Nothing

Cells(1, 1).Select

Unload UserForm1

End Sub

このQ&Aに関連する最新のQ&A

A 回答 (6件)

>変数値ですが、v(i)=(ドライブ名):\(ファイルが格納されているフォルダ名)もしくは、i=0です。


..そうでした..orz
フォルダを対象外にしなければいけませんね。
>tmp = "dir /b/s """ & drv & ":\*" & buf & "*"""
tmp = "dir /b/s/a:-d """ & drv & ":\*" & buf & "*"""
に変更です。

整理して、さらにfso使わないパターンで

Private Sub CommandButton1_Click()
  Const MX = 17
  Dim flg(1 To MX) As Boolean
  Dim ws As Worksheet
  Dim drv As String
  Dim buf As String
  Dim tmp As String
  Dim wrk As String
  Dim cnt As Long
  Dim n  As Long
  Dim x  As Long
  Dim a  As Long
  Dim i  As Long
  Dim v

  On Error GoTo errHndler
  For x = 1 To MX
    flg(x) = Me.Controls("CheckBox" & x).Value
  Next
  If Application.Or(flg) = False Then MsgBox "no check": Exit Sub

  buf = InputBox("検索したいファイル名を入力してください" & vbLf & _
          "ただし、複数キーワード検索はできません" & vbLf & _
          "キーワード入力後、「OK」ボタンを選択", "キーワード入力")
  If buf = "" Then Exit Sub

  Set shl = CreateObject("WScript.Shell")
  wrk = Application.DefaultFilePath & "\temp" & CLng(Date) & ".txt"

  For x = 1 To MX
    If flg(x) Then
      Set ws = Worksheets(x + 1)
      If Not ws Is Nothing Then
        drv = Chr(Asc("J") + x - 1)
        tmp = "dir /b/s/a:-d """ & drv & ":\*" & buf & "*"""
        shl.Run "%ComSpec% /c " & tmp & ">""" & wrk & """", 0, True

        n = FreeFile
        Open wrk For Input As #n
        v = Split(StrConv(InputB(LOF(n), #n), vbUnicode), vbCrLf)
        Close #n
        cnt = 0
        cnt = UBound(v)

        If cnt > 0 Then
          ws.Visible = True
          MsgBox "ドライブ " & drv & " に " & cnt & _
              " 個のファイルが見つかりました。", vbOKOnly, "検索結果"
          Application.ScreenUpdating = False
          a = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row + 1
          For i = 0 To cnt - 1
            With ws.Cells(a + i, 2)
              .Value = i + 1
              .Offset(, 1).Value = Mid$(v(i), InStrRev(v(i), "\") + 1)
              .Offset(, 2).Value = FileDateTime(v(i))
              .Worksheet.Hyperlinks.Add Anchor:=.Offset(, 1), _
                           Address:=v(i)
            End With
          Next
          Application.ScreenUpdating = True
        Else
          MsgBox "ドライブ " & drv & " 見つかりませんでした。"
          ws.Visible = False
        End If
        Set ws = Nothing
      End If
    End If
  Next

  On Error Resume Next
  Kill wrk
  On Error GoTo 0
  Set shl = Nothing
  Unload Me
  Exit Sub
errHndler:
  Debug.Print Err.Number, Err.Description
  Resume Next
End Sub
    • good
    • 0
この回答へのお礼

ありがとうございます。
教えて頂いた通りにしたらきちんと検索し動作しました。
何度も回答していただきありがとうございました。

お礼日時:2011/05/17 23:27

リンク貼ったページの続きに『変数値の参照』があります。

読みましたか?
http://www.asahi-net.or.jp/~ef2o-inue/vba_k/sub0 …

エラーで止まった時に v(i) にカーソルをあてると変数の内容がポップアップします。
もしくはVBE画面で[alt][v][s]。
[ローカルウィンドウ]を表示させて
変数の左にある+記号をクリックして変数の内容を確認できます。

または

Else
  On Error Resume Next
  With fso.getfile(v(i))
    r.Offset(, 1).Value = .Name
    r.Offset(, 2).Value = .DateLastModified
    r.Worksheet.Hyperlinks.Add Anchor:=r.Offset(, 1), _
                  Address:=.Path
  End With
  If Err.Number <> 0 Then
    r.Offset(, 1).Value = v(i)
  End If
  On Error GoTo 0
End If

エラー時はファイル名の代わりにフルパスをセルに入れるようにする、
などしてください。
    • good
    • 0
この回答へのお礼

返信遅れてすいません。
変数値ですが、v(i)=(ドライブ名):\(ファイルが格納されているフォルダ名)もしくは、i=0です。
フォルダは存在していて、その中に検索対象のファイルが格納されているのですが…
今回教えて頂いたものを少しいじってでやってみたのですが、検索結果が表示されません。
ファイル名もフルパスを入力するように変更しましたが、前回と同じWith fso.getfile(v(i))
の部分でエラーが出ます。
他のサイト見たり、VBAをいじったりしているのですが、難しくて結局出来ません…

お礼日時:2011/05/14 11:57

コードアップミス。


一箇所修正してください。

>drv = Chr(Asc("I") + x - 1)
drv = Chr(Asc("J") + x - 1)
    • good
    • 0

エラーメッセージが何か、エラー時の変数v(i)やxの値は何か、


くらいは書かないと話がすすみません。
デバッグのやり方は知っておいてください。
http://www.asahi-net.or.jp/~ef2o-inue/vba_k/sub0 …
http://www.asahi-net.or.jp/~ef2o-inue/vba_k/sub0 …

Private Sub CommandButton1_Click()
  Dim ws As Worksheet
  Dim fso As Object
  Dim glg As Boolean
  Dim drv As String
  Dim buf As String
  Dim tmp As String
  Dim wrk As String
  Dim r  As Range
  Dim x  As Long
  Dim n  As Long
  Dim a  As Long
  Dim i  As Long
  Dim cnt As Long
  Dim v

  buf = InputBox("検索したいファイル名を入力してください" & vbLf & _
          "ただし、複数キーワード検索はできません" & vbLf & _
          "キーワード入力後、「OK」ボタンを選択", "キーワード入力")
  If buf = "" Or buf = "False" Then Exit Sub

  Set fso = CreateObject("Scripting.FileSystemObject")
  wrk = Application.DefaultFilePath & "\temp" & CLng(Date) & ".txt"
  For x = 1 To 17
    flg = False
    On Error Resume Next
    flg = Me.Controls("CheckBox" & x)
    If Err.Number <> 0 Then
      MsgBox Err.Number & "::" & Err.Description
    End If
    On Error GoTo 0

    If flg Then
      Set ws = Nothing
      On Error Resume Next
      Set ws = Worksheets(x + 1)
      If Err.Number <> 0 Then
        MsgBox Err.Number & "::" & Err.Description
      End If
      On Error GoTo 0

      If Not ws Is Nothing Then
        drv = Chr(Asc("I") + x - 1)
        tmp = "dir /b/s """ & drv & ":\*" & buf & "*"""
        CreateObject("WScript.Shell") _
            .Run "%ComSpec% /c " & tmp & ">""" & wrk & """", 0, True

        n = FreeFile
        Open wrk For Input As #n
        v = Split(StrConv(InputB(LOF(n), #n), vbUnicode), vbCrLf)
        Close #n
        cnt = UBound(v)

        If cnt > 0 Then
          ws.Visible = True
          MsgBox "ドライブ " & drv & " に " & cnt & _
              " 個のファイルが見つかりました。", vbOKOnly, "検索結果"
          Application.ScreenUpdating = False
          a = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row + 1
          For i = 0 To cnt - 1
            Set r = ws.Cells(a + i, 2)
            r.Value = i + 1
            If Len(v(i)) > 259 Then
              r.Offset(, 1).Value = v(i)
              MsgBox "フルパスが長すぎます。"
            Else
              With fso.getfile(v(i))
                r.Offset(, 1).Value = .Name
                r.Offset(, 2).Value = .DateLastModified
                r.Worksheet.Hyperlinks.Add Anchor:=r.Offset(, 1), _
                              Address:=.Path
              End With
            End If
            Set r = Nothing
          Next
          Application.ScreenUpdating = True
        Else
          MsgBox "ドライブ " & drv & " 見つかりませんでした。"
          ws.Visible = False
        End If
      End If
    End If
  Next

  On Error Resume Next
  Kill wrk
  On Error GoTo 0
  Set fso = Nothing
  Unload Me
End Sub
    • good
    • 0
この回答へのお礼

回答ありがとうございます。
申し訳ありません。初心者なので説明がきちんとできてませんでした。
検索結果数が少ないとちゃんと動作するようになりました。
ただ検索結果が多いと「実行時エラー'53':ファイルが見つかりません。」と出ます。
With fso.getfile(v(i))がエラーの対象です。
しかし検索結果数はきちんと出ています。
エラー時の変数の値ですが、よくわかりません。
検索結果が0か1つ出てる時もあるので1か2でしょうか。
よろしくお願いします。

お礼日時:2011/04/28 19:30

ver2007以降、Application.FileSearchオブジェクトはサポートされていません。


http://support.microsoft.com/kb/920229/ja
代替手法でのコーディングが必要です。
以下、コマンドプロンプトのDIRコマンドを使う例。

Private Sub CommandButton1_Click()
 Dim fso As Object
 Dim drv As String
 Dim buf As String
 Dim tmp As String
 Dim wrk As String
 Dim r  As Range
 Dim x  As Long
 Dim n  As Long
 Dim a  As Long
 Dim i  As Long
 Dim cnt As Long
 Dim v

 For x = 1 To 17
  If Me.Controls("CheckBox" & x) = True Then Exit For 'チェックしてあるかを確認
 Next
 If x = 18 Then Exit Sub

 buf = InputBox("検索したいファイル名を入力してください" & vbCrLf & _
         "ただし、複数キーワード検索はできません" & vbCrLf & _
         "キーワード入力後、「OK」ボタンを選択", "キーワード入力")
 If buf = "" Or buf = "False" Then Exit Sub

 Set fso = CreateObject("Scripting.FileSystemObject")
 wrk = Application.DefaultFilePath & "\temp" & CLng(Date) & ".txt"
 For x = 1 To 17
  If Me.Controls("CheckBox" & x) = True Then
   drv = Chr(Asc("J") + x - 1)
   tmp = "dir """ & drv & ":\*" & buf & "*"" /b/s"
   CreateObject("WScript.Shell") _
       .Run "%ComSpec% /c " & tmp & ">""" & wrk & """", 0, True

   n = FreeFile
   Open wrk For Input As #n
   v = Split(StrConv(InputB(LOF(n), #n), vbUnicode), vbCrLf)
   Close #n
   cnt = UBound(v)

   With Sheets(x + 1)
    .Visible = True
    If cnt > 0 Then
     MsgBox "ドライブ " & drv & " に " & cnt & _
         " 個のファイルが見つかりました", vbOKOnly, "検索結果"
     Application.ScreenUpdating = False
     a = .Cells(.Rows.Count, "C").End(xlUp).Row + 1
     For i = 0 To cnt - 1
      Set r = .Cells(a + i, 2)
      With fso.getfile(v(i))
       r.Value = i + 1
       r.Offset(, 1).Value = .Name
       r.Offset(, 2).Value = .DateLastModified
       r.Worksheet.Hyperlinks.Add Anchor:=r.Offset(, 1), _
                     Address:=.Path
      End With
      Set r = Nothing
     Next
    Else
     MsgBox "ドライブ " & drv & " 見つかりませんでした"
     .Visible = False
    End If
   End With
  End If
 Next

 Kill wrk
 Set fso = Nothing
 Unload Me 'UserForm1
End Sub
    • good
    • 0
この回答へのお礼

ありがとうございます。
検索結果によってWith fso.getfile(v(i))やIf Me.Controls("CheckBox" & x) = True Thenの所でエラーが出ます。
ほとんどが前者のエラーが出ます。たまに後者のエラーも出るので統一性がわかりません。
検索結果数はきちんと出ますが、別シートに検索結果が表示されません。
もしよろしければ、こちらの方もお時間ありましたらお願いします。

お礼日時:2011/04/27 11:27

忙しい回答者の手を煩わすのだから、>エラーになります。

 はどの行か参考までに書くべきです。
ーー
また関係ないと思うコード部分は質問分からカットして質問文に載せるないこと。後半などはとりあえず質問と関係ないのでは。
質問者が色々試行して、エラーの起こっていそうな範囲を、狭めるのも大事なVBAの勉強でしょう。
ーー
本筋と関係ないかもしれないが
xが1から17まで繰り返してながら、そのループの中で
If x = 18 Then Exit Sub
とはなに?
こういうことも見抜けて以内。
ーー
>Excel2003では出来たのですが
は忘れてDebugに取り組むべきだ。
ーー
参考までにフォームに3つチェックボックスを設けて、テストしてみた
Private Sub CommandButton1_Click()
Set FSO = CreateObject("Scripting.FileSystemObject")
For x = 1 To 3
If Me.Controls("CheckBox" & x) = True Then GoTo p1 'チェックしてあるかを確認
Next x
MsgBox "チェックなし"
Exit Sub
p1:
MsgBox "チェックあり"
End Sub
上記は1つ見つかるとチェックを打ち切りだが、質問のコードは、この辺もおかしくないか。2つ以上チェックがあっても良いのか。
チェックが1つも入ってないときの事をどうしようとしているのか。
    • good
    • 0
この回答へのお礼

すいません。
ご指摘ありがとうございます。
If x = 18 Then Exit Subの部分ですが、xが18になったら抜けるようにしているのですが違いますか。
チェックは2つ以上あっても構いません。複数選択して検索させるためのものなので…
チェックが1つもないっていない場合は考えていませんでした。

お礼日時:2011/04/27 11:44

このQ&Aに関連する人気のQ&A

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

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

このQ&Aを見た人が検索しているワード

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

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

QExcel VBAのFileSearch機能

初めて投稿します。助けてください。
以下のVBAを使用して業務を行っているのですが
このマクロが動かなくなってしまいました。
ネット等で調べてわかったのですが
XP問題で社内PCがすべて変わりExcelも2013になってしまい
2013では、下記に記載されているFileSearch機能が使用できないようです。
出来れば下記の分をExcel2013でも
動くようにどの部分を変更すればいいいか教えていただけないでしょうか?

---------------------<VBA文>-------------------------
Sub 作成()
Dim i, j, no As Integer
Dim Mpath, Mname, Mfull As String

Mpath = ActiveWorkbook.Path
Mname = ActiveWorkbook.Name
Mfull = Mpath & "\" & Mname
Worksheets("一覧").Select
Range("A2:A200").Clear
With Application.FileSearch
.NewSearch
.LookIn = Mpath
.Filename = "*.xls"
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
For i = 1 To .Execute
If .FoundFiles(i) <> Mfull Then
Cells(i + 1, 1).Value = .FoundFiles(i)

j = Len(Cells(i + 1, 1))
If j > 218 Then
MsgBox ("218文字を超えてます。")
Exit Sub
End If

End If
Next i
Else
MsgBox ("見つかりませんでした。")
End If
End With
  Range("A2").Select
Range("A2:A1000").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal

End Sub

初めて投稿します。助けてください。
以下のVBAを使用して業務を行っているのですが
このマクロが動かなくなってしまいました。
ネット等で調べてわかったのですが
XP問題で社内PCがすべて変わりExcelも2013になってしまい
2013では、下記に記載されているFileSearch機能が使用できないようです。
出来れば下記の分をExcel2013でも
動くようにどの部分を変更すればいいいか教えていただけないでしょうか?

---------------------<VBA文>-------------------------
Sub 作成()
Dim i, j, no As Inte...続きを読む

Aベストアンサー

例えば、こんな感じでいかがでしょうか。

----------
Sub 作成()

Dim i As Integer, j As Integer, no As Integer
Dim Mpath As String, Mname As String, Mfull As String

Mpath = ActiveWorkbook.Path
Mname = ActiveWorkbook.Name
Mfull = Mpath & "\" & Mname
Worksheets("一覧").Select
Range("A2:A200").Clear

Dim result() As String
Call search(Mpath, result())

If UBound(result) > 0 Then
For i = 0 To UBound(result)
If result(i) <> Mfull Then
Cells(i + 1, 1).Value = result(i)

j = Len(Cells(i + 1, 1))
If j > 218 Then
MsgBox ("218文字を超えてます。")
Exit Sub
End If

End If
Next i
Else
MsgBox ("見つかりませんでした。")
End If

Range("A2").Select
Range("A2:A1000").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal


End Sub

Sub search(Mpath As String, result() As String)

Dim arrayFilePath As String
arrayFilePath = Dir(Mpath & "*.xls")

Dim i As Integer
i = 0
ReDim result(i)

Do Until arrayFilePath = ""
ReDim Preserve result(i)
result(i) = Mpath & arrayFilePath

i = i + 1
arrayFilePath = Dir()
Loop

End Sub

例えば、こんな感じでいかがでしょうか。

----------
Sub 作成()

Dim i As Integer, j As Integer, no As Integer
Dim Mpath As String, Mname As String, Mfull As String

Mpath = ActiveWorkbook.Path
Mname = ActiveWorkbook.Name
Mfull = Mpath & "\" & Mname
Worksheets("一覧").Select
Range("A2:A200").Clear

Dim result() As String
Call search(Mpath, result())

If UBound(result) > 0 Then
For i = 0 To UBound(result)
...続きを読む

QVBA 実行時エラー1004 rangeメソッドは失敗しました。globalオブジェクトのエラー

始めまして、VBA初心者のものです。
ただいまエクセルでグラフを作成しています。作業自体は単純作業の繰り返しなのでVBAを用いてやりたいのですが、マクロを実行したときに実行時エラー’1004’rangeメソッドは失敗しました。’_global’オブジェクトとメッセージが出て、実行できません。 デバックをすると以下の5行目で黄色のバーが出ていました。自分なりに原因を考えたのですがrangeの関係するところに、Range("A8:A1587,e8:e1587")というような変数を用いないやり方でやると上手くいくので、変数に関する定義がまずいと思うのですが、それ以上の事は分かりません。どなたか、分かる方がおりましたら、よろしくお願いします。また、プログラムは以下のようになります。

Sub 繰り返し()
'繰り返し
Dim s As Integer
For s = 0 To 17
Range("cells(8,1):cells(1580,1),cells(8,s+2):cells(1580,s+2)").Select
Range("cells(8,s+2)").Activate
Charts.Add
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSourceData Source:=Sheets("20081216_210647").Range( _
"cells(8,1):cells(1580,1),cells(8,s+2):cells(1580,s+2)"), PlotBy:=xlColumns
ActiveChart.SeriesCollection(1).Name = "=""0810p2x"""
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="0810p2x"
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "0810p2x"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "t"
.Axes(xlValue, xlPrimary).HasTitle = False
End With
Next
End Sub

始めまして、VBA初心者のものです。
ただいまエクセルでグラフを作成しています。作業自体は単純作業の繰り返しなのでVBAを用いてやりたいのですが、マクロを実行したときに実行時エラー’1004’rangeメソッドは失敗しました。’_global’オブジェクトとメッセージが出て、実行できません。 デバックをすると以下の5行目で黄色のバーが出ていました。自分なりに原因を考えたのですがrangeの関係するところに、Range("A8:A1587,e8:e1587")というような変数を用いないやり方でやると上手くいくので、変数に関する定義...続きを読む

Aベストアンサー

>ご指摘を受けたところを書き換えて回してみた結果、書き換えた箇所
>でエラーがでます。(実行時エラー’1004’’cells’メソッドは失敗
>しました。’global’オブジェクト)
>しかし、何が原因でエラーになるか自分では分かりません。

≪例1≫
Range(Cells(8, 1), Cells(1587, 2)).Select
上記の例では、RangeとかCellsの上位オブジェクトであるシート名が省略されています。
ActiveSheet.Range(ActiveSheet.Cells(8, 1), ActiveSheet.Cells(1587, 2)).Select
というわけです。
マクロ実行時に、Activeな(Excelで表示されている)シートが上位オブジェクトとして、自動的に認識されます。

≪例2≫
Sheets("Sheet2").Range(Cells(8, 1), Cells(1587, 2)).Select
上記の例では、Rangeのみシート名が記述されています。
Sheets("Sheet2").Range(ActiveSheet.Cells(8, 1), ActiveSheet.Cells(1587, 2)).Select
というわけです。
Activeなシートが、Sheet2の場合はエラーになりません。
しかし、ActiveなシートがSheet2以外の場合、エラーが発生します。
直前に、
Sheets("Sheet1").Select
などとしていれば、ActiveシートがSheet1になっていますから、エラーになります。

Sheets("Sheet2").Range(Sheets("Sheet2").Cells(8, 1), Sheets("Sheet2").Cells(1587, 2)).Select
と書いておけば安心です。
Withステートメントを使えばスッキリ纏めることができます。
With Sheets("Sheet2")
  .Range(.Cells(8, 1), .Cells(1587, 2)).Select
End With

# Sheets("Sheet2")の上位オブジェクトが省略されていることにも気がついてください。

>そこで自分で基礎を勉強したいのですが推薦できる参考書などがござ
>いましたら、教えていただけませんか?
私自身は、入門書程度の雑誌を1冊買っただけです。どれが良いとかはよく分かりません。
「マクロの記録」を活用して、参考コードを取得し、汎用性のあるコードに編集しています。
新しい単語があれば、文字カーソルを単語の上に置き、F1キーを押してVBAのヘルプを必ず見るようにしています。
躓いた時は、Web検索して欲しい情報を得たり、あるいは、こうした掲示板で先輩方のお力をお借りしています。

Excel(エクセル)VBA入門:目次
http://oshiete1.goo.ne.jp/kotaeru_reply.php3?q=4651404
エクセル入門・初級編
http://www.kenzo30.com/excel_kiso.htm

>ご指摘を受けたところを書き換えて回してみた結果、書き換えた箇所
>でエラーがでます。(実行時エラー’1004’’cells’メソッドは失敗
>しました。’global’オブジェクト)
>しかし、何が原因でエラーになるか自分では分かりません。

≪例1≫
Range(Cells(8, 1), Cells(1587, 2)).Select
上記の例では、RangeとかCellsの上位オブジェクトであるシート名が省略されています。
ActiveSheet.Range(ActiveSheet.Cells(8, 1), ActiveSheet.Cells(1587, 2)).Select
というわけです。
マクロ実行時に、Activeな...続きを読む

Qエクセル マクロで指定フォルダを開く

エクセルにて
指定フォルダを開く、マクロがあれば教えて頂けないでしょうか。
よろしくお願いいたします。

Aベストアンサー

こんにちは。

こういうものですか?
開くフォルダを変えたいときは targ に与えるパスを変更します。

Sub OpenFolders()
Dim targ As String
targ = "C:\"
Shell "C:\Windows\Explorer.exe " & targ, vbNormalFocus
End Sub

Qフォルダ内の全てのBookに同じ処理を繰り返す

フォルダ内にエクセルファイルが約3,000個あります。
この全てのBookに同じ処理をしたいのですが、マクロで繰り返す方法がわからないので教えて下さい。
処理をする内容は簡単なもので、マクロで作りました。

・ 各Bookには1つのシートしか存在せず、シート名は重要ではないので全て「Sheet1」になっています。
・ 各Bookのデータの配置や表形式は同じです。
・ レコードの行数がBookによって異なります。

処理の内容をマクロで作るところまではできましたが、知識がないためタイムアウトです。

ご教示宜しくお願い致します。

Aベストアンサー

だいたいこんな流れで。

sub macro1()
 dim myPath as string
 dim myFile as string

 mypath = "C:\test\"

’指定フォルダのブックを順繰り拾う
 myfile = dir(mypath & "*.xls*")
 do until myfile = ""

 ’ブックを開いて処理を行い保存して閉じる
  workbooks.open mypath & myfile
  activesheet.range("A1") = "DONE"
  activeworkbook.close true

  myfile = dir()
 loop
end sub


必要に応じて
・画面の表示を抑制する
・再計算を手動にする
といった手管を追加して高速化を図ります。

QエクセルVBAでテキストボックスの値の取得と変更について

エクセルのVBAを使ってシート上のテキストボックスのテキストを取得・変更するマクロを作成したいと思っていますがうまく行きませんので、お知恵を拝借したいとおもいます。

環境:WindowsXPでオフィス2002
状況:
エクセルブックa.xlsのシートに「コントロールツールボックス」のテキストボックスを配置(オブジェクト名はTEXTBOX_C)
エクセルブックb.xlsにコードを書き、a.xlsのTEXTBOX_CのプロパティのValueかTextを取りだしたい

試した事:
コントロールを配置したシートに次のマクロ
TEXTBOX_C.Text = "これはコントロールのテキストボックス"
を書くとテキストボックスに文字を入れ込めますが、別のエクセルブックからだと上手く行きません。

また、オートシェイプのテキストボックスの場合は簡単に出きるのですが、コントロールツールボックスではどうしても上手く行きませんので、対象法などご存知の方いらっしゃいましたら教えてください

Aベストアンサー

エクセルを新規に開きました。
そのSheet1に(コントロールツールボックスの)TextBoxを貼りつけました。
そのBook1から、ファイル-開くで別ブックを開きました。
別ブックのMojule1側に下記を書いて
Sub test02()
MsgBox Workbooks("book1").Worksheets("sheet1").textbox1.Text
End Sub
を実行すると、Book1のTextBoxに入れた文字列が表示
されました。
がそんな質問ではないのですか。

QVBAで別エクセルファイルから指定エクセルファイルにシートをコピー

Office2003のエクセルでVBAを勉強しております。

そこで、VBAで別エクセルファイルからあるシートを指定エクセルファイルへ丸まるコピーしたい場合にはどのようにすればよいのでしょうか?

Aベストアンサー

Sheets("A").Copy Before:=Workbooks("Book1").Sheets(1)


>Office2003のエクセルでVBAを勉強しております。

方法が解らなければ、記録マクロを確認するのが一番です。
動作が理解出来たら、コードの最適化を行ってください。

Q【Excel VBA】マクロでExcel自体を終了させたい

環境:WindowsXP、Excel2003

マクロでエクセルを終了(ブックを閉じて、アプリケーション自体も終了)させたいのですが、以下のコードではアプリケーションが閉じてくれません。

ThisWorkbook.Close
ExcObj.Quit
Application.Quit

どこか悪いところはありますでしょうか?

よろしくお願いします。

Aベストアンサー

普通に考えれば質問者のコードで上手くいきそうですが
hana-hana3さんの回答にもあるようにThisWorkBook.Closeでコード終了となりますので
Application.QuitをThisWorkBook.Closeの前にもってこないといけません。
Application.Quitはそれがあるプロシージャのコードが全て終わるまで
その実行を保留するちょと特別動作をします。

'-------------------------------------
 Application.Quit
 ThisWorkbook.Close
'-------------------------------------
 
 

QVB上で実行中の無限ループの止め方

今まで、CUIベースのBASICでのプログラムの経験はあるのですが
Visual系のBASICは初心者です。
原因はわかっているのでプログラムの修正はできるのですが
VB上でコンパイルして実行したときに無限ループに陥ってしまって
どうにもプログラムをとめられなくなります。
そんなことがないように、実行前に全てのプロジェクトを保存して
いますので、そんなに実害はないのですが、どうすればとめられるのでしょう・・
今現在は、タスクマネージャーから強制終了させています。

Aベストアンサー

無限ループの一番内側に
DoEvents
を入れておくと、ウィンドウ切替え->デバッガ終了操作が出来ますよ

危なそうなとこにも入れておくと、何かと安心です。

QEXCELファイルのカレントフォルダを取得するには?

EXCELファイルのカレントフォルダを取得するには?

C:\経理\予算.xls

D:\2005年度\予算.xls

EXCEL97ファイルがあります。

VBAで
  カレントフォルダ名
(C:\経理\,D:\2005年度\)
を取得する事は可能でしょうか?

CURDIRでは上手い方法が見つかりませんでした。

Aベストアンサー

こんばんは。
Excel97 でも、同じですね。以下で試してみてください。

Sub test()
'このブックのパス
a = ThisWorkbook.Path
'アクティブブックのパス
b = ActiveWorkbook.Path
'Excelで設定されたデフォルトパス
c = Application.DefaultFilePath
'カレントディレクトリ
d = CurDir
MsgBox "このブックのパス   : " & a & Chr(13) & _
   "アクティブブックのパス: " & b & Chr(13) & _
   "デフォルトパス    : " & c & Chr(13) & _
   "カレントディレクトリ : " & d & Chr(13)
End Sub


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

人気Q&Aランキング