当方は1,000個以上のPDFファイルを所有しています。それぞれのPDFファイルのページ数を知りたいのですが、このページ数を簡単に検索(一括表示)できる無料ツールなどを知っている方は是非、教えてください。

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

A 回答 (7件)

初めまして。


私も同じようなことをしようと思い、色々探していました。

それで下記のサイトにある「ComPDF」を使ってみたらいかがでしょうか。
シェアウェアですが、ページ数を調べるのでしたら大丈夫でしたよ。
私が調べたアプリの中では精度がかなりいいです。

http://www.ne.jp/asahi/foresth/home/
    • good
    • 0

一応改良


一部ページ数が0と表示される物もありますが、それは単一ページのはずです
文字数の関係でFunction getFOLDER() As String以下は有りませんがそれは前回の回答から拾ってください

Sub PDFページ改良()
Const cnsDIR = "\*.pdf"
Dim xlAPP As Application
Dim strFILENAME As String
Dim GYO As Long
Dim cCOUNT As Long
Dim P As Long
Dim strFolder As String
Dim PageCOUNT As String
Dim c As Object
strFolder = getFOLDER()
If strFolder = "キャンセル" Then
Exit Sub
End If
strFILENAME = Dir(strFolder & cnsDIR, vbNormal)
Do While strFILENAME <> ""
P = 0
GYO = GYO + 1
Cells(GYO, 1).Value = strFILENAME
Application.ScreenUpdating = False
Workbooks.OpenText Filename:=strFolder & "\" & strFILENAME, _
Origin:=932, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
Set c = Cells.Find(What:="Count", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, MatchByte:=False, SearchFormat:=False)
If Not c Is Nothing Then
fAddress = c.Address
Do
PageCOUNT = c.Value
cCOUNT = Left(Mid(PageCOUNT, InStr(PageCOUNT, "/Count") + 7, 99), InStr(Mid(PageCOUNT, InStr(PageCOUNT, "/Count") + 7, 99) & "/", "/") - 1)
If P < cCOUNT Then
P = cCOUNT
End If
Set c = Cells.FindNext(c)
If c.Address = fAddress Then Exit Do
Loop
End If
ActiveWorkbook.Close SaveChanges:=False
Application.ScreenUpdating = True
Cells(GYO, 2).Value = P
strFILENAME = Dir()
Loop
End Sub
    • good
    • 5

No3です


作ってからいろいろ試したら、不具合が出てますね

しおり形式で作成されたPDFファイルの場合、しおり数が表示されて実際のページ数表示ではなかったり
PDFファイルによってはエラーになる場合があるようです

参考程度に留めて置いてください
    • good
    • 0

Sub PDFページ()


Const cnsDIR = "\*.pdf"
Dim xlAPP As Application
Dim strFILENAME As String
Dim GYO As Long
Dim strFolder As String
Dim PageCOUNT As String

strFolder = getFOLDER()

If strFolder = "キャンセル" Then
Exit Sub
End If
strFILENAME = Dir(strFolder & cnsDIR, vbNormal)
Do While strFILENAME <> ""
GYO = GYO + 1
Cells(GYO, 1).Value = strFILENAME
Application.ScreenUpdating = False
Workbooks.OpenText Filename:=strFolder & "\" & strFILENAME, _
Origin:=932, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
Cells.Find(What:="COUNT", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, MatchByte:=False, SearchFormat:=False).Activate
PageCOUNT = ActiveCell.Value
ActiveWorkbook.Close SaveChanges:=False
Application.ScreenUpdating = True
Cells(GYO, 2).Value = Left(Mid(PageCOUNT, InStr(PageCOUNT, "/Count") + 7, 99), InStr(Mid(PageCOUNT, InStr(PageCOUNT, "/Count") + 7, 99) & "/", "/") - 1)
strFILENAME = Dir()
Loop

End Sub

Function getFOLDER() As String

Dim objShell As Object
Dim objFolder As Object
Const strTitle = "フォルダを選択してください。"
Set objShell = CreateObject("Shell.Application")
Const lngRef = &H1
Const fldRoot = &H0
Set objFolder = _
objShell.BrowseForFolder(0, _
strTitle, lngRef, fldRoot)
If objFolder Is Nothing Then
getFOLDER = "キャンセル"
Else
If objFolder.ParentFolder Is Nothing Then
getFOLDER = "デスクトップ"
Else
getFOLDER = objFolder.Items.Item.Path
End If
End If

Set objFolder = Nothing
Set objShell = Nothing

End Function
    • good
    • 0

No1様の回答は私の環境でも表示されませんでした(Windows7)


(7では動作しないのかな?)

それはさておき
PDFファイルのファイル情報取得ソフトはネット検索すると結構出てきますが、ページ数の取得可能な物は有料のソフトしか発見できませんでした。

http://www.hypergear.com/pcounter/
http://www.gengokk.co.jp/editpdf.htm
結構高価

無料の物で
http://homepage3.nifty.com/e-papy/p2.html

ただ、ページ数まで取得できるかは良くわかりませんでした

見つからなければ作ってしまえば良い!!

と言う事で、エクセルのマクロでページ情報のみ取得する方法
(結構強引にやってるので無駄が多いですが)

文字数制限のため、マクロ自体は別回答で行いますが

http://www.ken3.org/vba/vba-folder.html
http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub0 …

上記サイトのサンプルと、マクロの記録の組み合わせで
指定したフォルダー内のPDFファイル名とページ数のみを表示するマクロになっています
    • good
    • 0

No.1の回答者です。

補足を見ました。

> なぜかページ数項目は全て空白(非表示)になってます・・・
読み込みに時間がかかっているだけでは?
エクスプローラーを開いたまま、ある程度時間をおいてみては。
ページ数を読み込むのにある程度処理時間が必要なようなので。

ファイルを右クリックして表示されるメニューから[プロパティ]を
指定して開く[プロパティ]ダイアログの[全般]タブにある情報は、
読み込みが早くできるようになってて処理が瞬時になっているので
開くとすぐ表示されるのですが、他のタブにある項目などは一つの
ファイルごとに探して読み込むらしく、かなりの処理時間が必要な
ようですので。エクスプローラーで表示される[全般]タブ以外のは
ファイル数が多いために、処理時間がかなりかかっているのかも。

それでも表示されないとしたら、私には原因がわかりません。
もしかしたら関連付けされたアプリケーションの関係なのかも。
そうだとするなら、Adobe Readerに変更してみるとか?
    • good
    • 0

Windowsなら[エクスプローラー]の[表示]を[詳細]にして、


[詳細表示の設定]で[ページ数]にチェックを付けておけば、
簡単にみることができますが。この方法では駄目なの?
http://www.atmarkit.co.jp/fwin2k/win2ktips/584ec …

ツールなど使用しなくてもすむ方法なので、試してみては。
「複数あるPDFファイルのページ数を知りた」の回答画像1

この回答への補足

ありがとうございます!無事にページ数の欄を表示させることができましたが、なぜかページ数項目は全て空白(非表示)になってます・・・。(実際の数字部分)何が原因なのでしょうか?

補足日時:2011/04/19 23:38
    • good
    • 0

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

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

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

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

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

QPDFのページ数を調べたい

お世話になります。
1,500件くらいのPDFファイルがあります。各ファイルのページ数はバラバラです。全てのPDFファイルのページ数を調べてエクセルで一覧表にするのですがファイルを開かずにページ数を取得する方法はないでしょうか?
Acrobat5.0及び6.0あります。
その他フリーソフトでできればOKです。
アドバイスおねがいします。

Aベストアンサー

> AppActivate "Adobe Reader"が黄色くなっています。
> 1枚目のPDFファイルは開き、そのファイル名もB1セルに書き込まれま
> すがそこで止まる状況です。

最初のファイルのページ数が書き込まれていないのは、おそらくアクテ
ィブ化しようとしているプログラムの名前が "Adobe Reader" ではない
のでウィンドウを取得できていないのでしょう。

AdobeReader8.0を単独で開いたとき、そのタイトルバーの左端にある
アイコンの右側に表示されているプログラム名は何でしょうか?
私のバージョン(6)では、Adobe Reader と表記されていますので、
 AppActivate "Adobe Reader"
で有効なのですが。
異なっている場合は、実際の文字列に書き換えてみてください。

> ショートカットキー押下の組み合わせとのことですが、

"^{END}+^{N}^{C}~%(FC)" と "%(FX)" の先頭からの順番です。
 ^{END}: [Ctrl]を押しながら[END] → 最終頁にジャンプ
 +^{N}: [Shift]と[Ctrl]を押しながら[N] → 頁指定ダイアログ表示
 ^{C}: [Ctrl]を押しながら[C] → ダイアログ内現頁の数値をコピー
 ~: [Enter] → ダイアログの[OK]をクリックと同じ意
 %(FC): [Alt]を押し続けながら[F][C] → ファイルをクローズ
 "%(FX)": [Alt]を押し続けながら[F][X] → Adobe Reader をクローズ

> AppActivate "Adobe Reader"が黄色くなっています。
> 1枚目のPDFファイルは開き、そのファイル名もB1セルに書き込まれま
> すがそこで止まる状況です。

最初のファイルのページ数が書き込まれていないのは、おそらくアクテ
ィブ化しようとしているプログラムの名前が "Adobe Reader" ではない
のでウィンドウを取得できていないのでしょう。

AdobeReader8.0を単独で開いたとき、そのタイトルバーの左端にある
アイコンの右側に表示されているプログラム名は何でしょうか?
私のバージョン(6)では、...続きを読む

QPDFファイルから特定の文字を検索し、頁を抽出する方法

PDFファイルの文書の中から、特定の文字列を検索し、その文字が含まれているページだけを抽出して別のPDFファイルを作る方法を教えてください。
検索結果の件数は表示されるのですが、その頁を抽出(あるいは、文字を含まない頁を削除)する方法がわかりません。
元のページ数が多いので、手作業での不要ページ削除が難しく大変困っています。
(win7でAdobe Acrobat 11 Standardを使用しています) 
どうかよろしくお願いいたします。

Aベストアンサー

検索結果から文字列のあるページをクリックして表示しておけば、その
ページ番号などが分かります。それでページのみでの抽出をすることは
可能だと思いますよ。
https://helpx.adobe.com/jp/acrobat/kb/3320.html
http://www.itmedia.co.jp/bizid/articles/1304/01/news007.html

QエクセルVBAで、PDFファイルを開きたい

セルに入力した値のブック(xls)を開く場合、
以下となりますが、↓

Sub セルに入力したブック名のブックを開く()
ブック名 = Cells(1, 2) 'B1セルの値を取り出す
Workbooks.Open Filename:=ブック名 & ".xls" '指定されたブックを開く
End Sub


これでPDFファイルを開きたいです。
記述をどうしたらよいでしょうか。
目的はPDFファイルの検索/照会をxlsにてしたいのです。
お手数ですがお願いいたします。

Aベストアンサー

案1
ハイパーリンクにしてしまう。

案2
PDFファイルへのフルパスが、B列に記述してある
拡張子PDFへの関連付けがAcrobat Reader にしてある
と仮定して
ワークシートのイベントに

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If InStr(Target.Value, "pdf") > 0 Then
  Call Shell("explorer.exe " & Target.Value)
  Cancel = True '編集モードキャンセル
End If
End Sub
とか?

PDFファイルが一箇所にまとまっているのなら
標準モジュールに
Sub test2()
Dim strFilePath As String
strFilePath = _
  Application.GetOpenFilename _
  ("PDFファイル,*.pdf", MultiSelect:=False)

If strFilePath = "false" Then
 Exit Sub
End If

Call Shell("explorer.exe " & strFilePath)

End Sub
でも?
ということかな?

案1
ハイパーリンクにしてしまう。

案2
PDFファイルへのフルパスが、B列に記述してある
拡張子PDFへの関連付けがAcrobat Reader にしてある
と仮定して
ワークシートのイベントに

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If InStr(Target.Value, "pdf") > 0 Then
  Call Shell("explorer.exe " & Target.Value)
  Cancel = True '編集モードキャンセル
End If
End Sub
とか?

PDFファイルが一箇所にまとまっているのなら
標準モジュー...続きを読む

Qフォルダ階層・ファイル名・ページ数の一覧を出したい

複数あるフォルダ内に入っている、全てのサブフォルダ及びファイルの名前、ページ数をリストにする方法はないでしょうか。出来ればエクセルに出力したいと考えています。
ページ数を表記したいものはPDFファイルのみで、PDFファイル以外はファイルの名前のみを表記したいと思っています。

現在は、ページ数を除き、
http://q.hatena.ne.jp/1176949723
にあります「調査.vbs」という名前で保存する方法を元に作成したファイルを使用して、
調査したいフォルダをファイルに移動したら勝手に一覧になる方法で行っています。


使用するPC環境では、フリーソフト等がダウンロード・インストールができないため、
それ以外の方法でと考えています。


よろしくお願いいたします。

Aベストアンサー

何をキーワードにして、Googleったのか忘れてしまいました。。
とりあえず、acrobat PDF pagecount で行ったところで発見したもので
作ってみましたが? 当方 Acrovat は持ち合わせておりません (^^ゞ

Function PDFPages(sPDFPath As String) As Long
'http://forums.adobe.com/message/2696593 ←オリジナル
  Dim oAcro As Object
  Dim AVDoc As Object
  Dim PDDoc As Object
  
  Set oAcro = CreateObject("Acroexch.app")
  oAcro.Show '可視・不可視切り替え
  Set AVDoc = CreateObject("AcroExch.AVDoc")
  
  If AVDoc.Open(sPDFPath, "") Then
    Set PDDoc = AVDoc.GetPDDoc()
    PDFPages = PDDoc.GetNumPages
  End If
  
  Set PDDoc = Nothing
  Set AVDoc = Nothing
  Set oAcro = Nothing
End Function

参照設定にチェックを入れられば、処理速度も改善されるかも?
私からは、ここまでです。<m(__)m>

何をキーワードにして、Googleったのか忘れてしまいました。。
とりあえず、acrobat PDF pagecount で行ったところで発見したもので
作ってみましたが? 当方 Acrovat は持ち合わせておりません (^^ゞ

Function PDFPages(sPDFPath As String) As Long
'http://forums.adobe.com/message/2696593 ←オリジナル
  Dim oAcro As Object
  Dim AVDoc As Object
  Dim PDDoc As Object
  
  Set oAcro = CreateObject("Acroexch.app")
  oAcro.Show '可視・不可視切り替え
  Set AVDoc = CreateObject(...続きを読む

QVBからPDFファイルの埋め込みテキストを検索する方法

VBで文書を検索できるシステムを作っています。
通常検索では、テキストボックスに入力した文字列と一致するものをデータベースに登録した文書名から探してきてMSHFlexGridコントロール上に表示するようにしています。
今回は、追加検索として、指定したフォルダの中にあるPDFファイルやワードファイルなどの文書中の文字から一致するものを探して表示する機能を作りたいと考えています。
この様な機能はどの様に作れば良いのでしょうか?
色々とサイトを探してみたのですが、該当するものを見つけることが出来ませんでした。
よろしくお願いします。

Aベストアンサー

こんにちは。

[xdoc2txt]
PDF,WORD,EXCEL,一太郎などの各種バイナリ文書からテキストを抽出
http://www31.ocn.ne.jp/~h_ishida/xdoc2txt.html

VB から xdoc2txt.exe を起動して抽出テキストをリダイレクトする。
または、ActiveX 版 xdoc2txt.ocx を使うとか。

一から VB でとなると恐ろしく面倒で、難しいですよ。

まず速度面の問題があるでしょうし、ファイルフォーマットの解析が
必要になったり。。

QPDFファイルを開き、印刷し、閉じるマクロ

Excel 2003 VBAにて、
PDFファイルを開き、印刷し、閉じるマクロを作りたいと思っています。

Dim AA, AAA

AA = "C:\Program Files\Adobe\Reader 11.0\Reader\AcroRd32.exe C:\Scan\20131101160734050_001.pdf"
AAA = Shell(AA, vbNormalFocus)

にて、PDFファイルを開くことは出来ました。
このPDFファイルを、「印刷し、閉じる」ためには、
このPDFファイルを指定する必要があると思いますが、
その構文が判りません。
知っている方、教えて下さい。

Aベストアンサー

#3です。
WShell.Execを使うと閉じる事ができる様ですが、色々と気難しくて苦労しました。
まず、なぜかAdobe Reader/Acrobatのフルパスを与えないと、ファイルがみつからないとゴネます。

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub test()
printPdf2 GetDesktopPath & "\test.pdf", "DocuWorks Printer", "DocuWorks Printer Driver"
' printPdf2 GetDesktopPath & "\test.pdf"
End Sub

Sub printPdf2(pdfDocument As String, Optional printerName As Variant, Optional printerDriver As Variant)
Dim cmdLine As String
Dim WShell As Object
Dim oExec As Object
'ここは調整の必要がありそう
Const waitTime As Long = 1000
'Windows7 Home 64bitの場合です
Const pgmFullPath As String = "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe"

Set WShell = CreateObject("WScript.Shell")
If IsMissing(printerName) Or IsMissing(printerDriver) Then
cmdLine = "pgmFullPath /n /s /o /h /t ""pdfFullPath"""
cmdLine = Replace(cmdLine, "pgmFullPath", pgmFullPath)
cmdLine = Replace(cmdLine, "pdfFullPath", pdfDocument)
Else
cmdLine = "pgmFullPath /n /s /o /h /t ""pdfFullPath"" ""printerName"" ""printerDriver"""
cmdLine = Replace(cmdLine, "pgmFullPath", pgmFullPath)
cmdLine = Replace(cmdLine, "pdfFullPath", pdfDocument)
cmdLine = Replace(cmdLine, "printerName", printerName)
cmdLine = Replace(cmdLine, "printeDriver", printerDriver)
End If
Debug.Print cmdLine
Set oExec = WShell.exec(cmdLine)
Sleep waitTime
'Windows7Home/64bit環境ではここで実行時エラーが出るので無理矢理先に進めていますが
'Adobe Readerは閉じられる様です
On Error Resume Next
oExec.Terminate
Set WShell = Nothing
End Sub

Private Function GetDesktopPath() As String
Dim wScriptHost As Object, strInitDir As String
Set wScriptHost = CreateObject("Wscript.Shell")
GetDesktopPath = wScriptHost.SpecialFolders("Desktop")
Set wScriptHost = Nothing
End Function

Terminateで原因不明のエラーが出るのでWebを漁っいて下記をみつけました。64bit環境でエラーが出るのはこれも関係しているのでしょうか?少々無理をしている様なので、ご使用時はご注意下さい。
Terminate メソッドは最後の手段としてのみ使用します。これは、アプリケーションによっては適切にクリーンアップできない場合があるためです。通常は、プロセスを途中で中断せず、プロセス自身で実行を終了させるようにします。Terminate メソッドは WM_CLOSE メッセージを使ってプロセスを終了しようとします。これで終了できない場合は、通常のシャットダウン手順を実行せずに、プロセスを強制終了します。
http://msdn.microsoft.com/ja-jp/library/cc364387.aspx

#3です。
WShell.Execを使うと閉じる事ができる様ですが、色々と気難しくて苦労しました。
まず、なぜかAdobe Reader/Acrobatのフルパスを与えないと、ファイルがみつからないとゴネます。

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub test()
printPdf2 GetDesktopPath & "\test.pdf", "DocuWorks Printer", "DocuWorks Printer Driver"
' printPdf2 GetDesktopPath & "\test.pdf"
End Sub

Sub printPdf2(pdfDocument As String, Optional printerName As Variant, Optional prin...続きを読む

Qワードを開かずにページ数だけ調べたい!

宜しくお願いします。

ワードのファイルを開かずにページ数だけ調べることは出来るでしょうか?

アンケートを1000通程送り返送が着ているのですが、
人によってはかいたところだけ送ってくる人、
アンケートに複数の人が書いて、ページを増やして回答してくる人などがいます。

一つ一つ開いて、調べるのも1000通になると難しく・・・。

ファイル一覧が表示されるウィンドウでも、”詳細表示”にしても
ページ数までは表示されず。。。

知恵を貸してください

宜しくお願いします

Aベストアンサー

こんばんは。

最初に、BuiltInDocumentProperties は、一旦、開いて、開いたページを、Repaginate しないと取れません。#1の方の引用先のコードは、小さなファイルは可能ですが、大きなファイルでは正しいページが出てこないはずです。

私の考えたものです。

Sub GetWordProperties()
  Dim wdApp As Word.Application
  Dim wdDoc As Word.Document
  Dim Fname As Variant
  Dim Fnames As Object
  Dim msg As String
  Dim wdCnt As Long, wdtitle As String
 
  With Application.FileDialog(msoFileDialogOpen)
   .Show
  Set Fnames = .SelectedItems
  If Fnames.Count = 0 Then
   Exit Sub
  Exit Sub
  End If
  End With
  For Each Fname In Fnames
  Set wdDoc = Application.Documents.Open(Fname, , True)
  With wdDoc
   .Repaginate
   wdtitle = .BuiltInDocumentProperties(wdPropertyTitle)
   wdCnt = .BuiltInDocumentProperties(wdPropertyPages)
   .Close False
  End With
  Set wdDoc = Nothing
  msg = msg & vbCrLf & wdtitle & " 総ページ数: " & wdCnt
  Next Fname
  MsgBox msg
End Sub


開かないで、ページ数などの情報を取れる、Dsofile という、タイプライブラリを使う方法があるのですが、ひとつ欠陥があります。一旦、印刷していないものは出来ません。

http://support.microsoft.com/kb/224351/ja
Visual Basic .NET 2003 および Visual Basic .NET 2002 で Dsofile.dll を使用すると Office がなくても Office ドキュメントのプロパティを編集できる

それから、ファイル-ファイルを開くで、プロパティ表示をしたらどうでしょうか。人が一旦作って保存したものなら、プロパティが出てくるはずですから、1,000ぐらいなら、何とかなるかもしれません。ただ、すべてのDocument にプロパティが見れるとは限りません。

こんばんは。

最初に、BuiltInDocumentProperties は、一旦、開いて、開いたページを、Repaginate しないと取れません。#1の方の引用先のコードは、小さなファイルは可能ですが、大きなファイルでは正しいページが出てこないはずです。

私の考えたものです。

Sub GetWordProperties()
  Dim wdApp As Word.Application
  Dim wdDoc As Word.Document
  Dim Fname As Variant
  Dim Fnames As Object
  Dim msg As String
  Dim wdCnt As Long, wdtitle As String
 
  With Application....続きを読む

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

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

Aベストアンサー

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

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

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

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む


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

人気Q&Aランキング