出産前後の痔にはご注意!

ACCESS VBA TIFF形式のファイルの解像度を取得したいです。

以前の書き込みに幅×高さのピクセル値の求め方がかかれてあり、理解しました。

用紙サイズの判別に上記の 幅x高さと解像度を利用しようと考えています。

よろしくお願いします。

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

A 回答 (1件)

大げさな方法。

なんとか2K文字をクリア。ご参考まで。

Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Declare Function GdipCreateBitmapFromFile Lib "Gdiplus" (FileName As Any, bitmap As Long) As Long
Private Declare Function GdipDisposeImage Lib "Gdiplus" (ByVal Image As Long) As Long
Private Declare Function GdipGetImageHeight Lib "Gdiplus" (ByVal Image As Long, Height As Long) As Long
Private Declare Function GdipGetImageWidth Lib "Gdiplus" (ByVal Image As Long, Width As Long) As Long
Private Declare Sub GdiplusShutdown Lib "Gdiplus" (ByVal token As Long)
Private Declare Function GdiplusStartup Lib "Gdiplus" (token As Long, pInput As GdiplusStartupInput, pOutput As Any) As Long
Private Declare Function GdipGetImageHorizontalResolution Lib "Gdiplus" (ByVal Image As Long, resolution As Single) As Long
Private Declare Function GdipGetImageVerticalResolution Lib "Gdiplus" (ByVal Image As Long, resolution As Single) As Long
Sub test()
Dim udtInput As GdiplusStartupInput
Dim lngToken As Long, lngStatus As Long
Dim pSrcBmp As Long, pDstBmp As Long
Dim lngWidth As Long, lngHeight As Long
Dim horResln As Single, verResln As Single
Dim srcPath As String

srcPath = "C:\Documents and Settings\????????\デスクトップ\hoge.tif"
udtInput.GdiplusVersion = 1
If GdiplusStartup(lngToken, udtInput, ByVal 0&) <> 0 Then
Exit Sub
End If
If GdipCreateBitmapFromFile(ByVal StrPtr(srcPath), pSrcBmp) <> 0 Then
GdiplusShutdown lngToken
Exit Sub
End If
GdipGetImageWidth pSrcBmp, lngWidth
GdipGetImageHeight pSrcBmp, lngHeight
Debug.Print lngWidth, lngHeight
GdipGetImageHorizontalResolution pSrcBmp, horResln
GdipGetImageVerticalResolution pSrcBmp, verResln
Debug.Print horResln, verResln
GdipDisposeImage pSrcBmp
GdiplusShutdown lngToken
End Sub

参考URL:http://arkham46.developpez.com/articles/office/c …
    • good
    • 0
この回答へのお礼

mitarashiさま

ご回答ありがとうございました。

悩んでいたことが解決しました。

お礼日時:2010/06/29 08:52

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

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

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

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

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

QVB6でTIFF図のプロパティをリスト化する?!

自分は駆け出しのVBユーザーなのですが、
自身が撮影した複数枚の写真(TIFFファイル)を対象にファイル名、縦横サイズ(ピクセル値)、解像度(dpi)、ビット深さ(1ビット?)を取得して、EXCELにリスト化できないか悪戦苦闘中です。
ググってみると「GDI+」なるものを活用する・・・のかな・・・?というレベルです。
なにぶんはじめたばかりで、1ファイルのファイル名を出す事しかできていません。
是非、お力をお借りしたいのですが、、、
VBのプログラムをおしえてください!
おねがいします!!!!

Aベストアンサー

画素数と解像度だけですが下記にVBAのコードを回答しています。GDI+のAPIを使っているだけなので、VB6でも通用すると思います(たぶん)
http://oshiete.goo.ne.jp/qa/6001735.html

こちらで公開しているクラスはVBA用ですが、中味がみられますのでVB6のご参考にもなるでしょう。
http://arkham46.developpez.com/articles/office/clgdiplus/

上記クラスの紹介をしている日本語の記事です
http://www.f3.dion.ne.jp/~element/msaccess/AcTipsFrmGdiClass.html

以上、ご参考まで。

QEXCEL VBA tif画像のプロパティ(page数がもらいたい)

実はVBAでtif画像のページ数が知りたいです。
教えてください。
ありがとうございます。

Aベストアンサー

なんか、いかにも「とりあえず」なコードですが…^^;;

下記のFunctionプロシージャを設置すれば、
 Sample(【対象ファイルのフルパス】,【プロパティ名】)
という形で対象ファイルのプロパティが得られます。

例えば、
'--------------↓ タトエバ ↓---------------
Sub test()
 MsgBox Sample("C:\hoge\piyo.tif", "ページ数")
End Sub
'------------↑ コンナカンジ ↑-------------
とすれば、
「C:\hoge」フォルダにある「piyo.tif」ファイルのページ数が表示されます。


'==========================↓ ココカラ ↓==========================
Function Sample(ByVal tgtPth As String, ByVal tgtIdx As String) As Variant
 Dim objShl As Object
 Dim fldNam As Variant
 Dim fleNam As Variant
 Dim tmpAry As Variant
 Dim i   As Long
 tmpAry = Split(tgtPth, "\")
 fleNam = tmpAry(UBound(tmpAry))
 fldNam = Left(tgtPth, Len(tgtPth) - Len(fleNam))
 Set objShl = CreateObject("Shell.Application")
 With objShl.Namespace(fldNam)
  For i = 0 To 999
   If .GetDetailsOf("", i) = tgtIdx Then
    Sample = .GetDetailsOf(.ParseName(fleNam), i)
    Exit For
   End If
  Next i
 End With
 Set objShl = Nothing
End Function
'==========================↑ ココマデ ↑==========================

以上ご参考まで。

なんか、いかにも「とりあえず」なコードですが…^^;;

下記のFunctionプロシージャを設置すれば、
 Sample(【対象ファイルのフルパス】,【プロパティ名】)
という形で対象ファイルのプロパティが得られます。

例えば、
'--------------↓ タトエバ ↓---------------
Sub test()
 MsgBox Sample("C:\hoge\piyo.tif", "ページ数")
End Sub
'------------↑ コンナカンジ ↑-------------
とすれば、
「C:\hoge」フォルダにある「piyo.tif」ファイルのページ数が表示されます。


'=============...続きを読む

QマルチページTIFFで指定ページを直接表示する方法は?

お世話になります。
現在、MS-AccessでTIFFファイル(名前と内容)を管理しています。
検索すると、目的の情報が○ページ目にあるか分かるようにしていますが、
TIFFファイルを開いて目的のページまで進むのが面倒です。
ファイルを開く時に、開いた時に表示されるページを指定する方法はありませんか?

OS:WinXP Pro
viewer:画像とFAXビューア

方法があるならば、他のviewerでもOKです。
宜しくお願いします。

Aベストアンサー

No.1 です。

コマンドラインから起動できれば、

i_view32.exe <画像ファイル名> /page=5

で出来るようです。

QVBAでTIFF画像を読み込むには?

お世話になります。Windows8.5+OFFICE2013で、アドオンや外部ライブラリ、ソフトのインストールやオンラインアプリケーションの利用はできない環境下での相談です。

画像ファイルを読み込んでVBAでGetpixcelにより塗りと位置の情報を取得しようとしています。小さなBitmapではLoadPictureで画像を取得できましたが、実際はA4サイズのTIFFのみ出力できるスキャナを使用する予定です。枚数が3000枚以上あるのでPrintscreenでBMP化という荒業は極力避けたいと考えていますが、どのようにすれば画像のピクセル情報を読むことができるのでしょうか。どうぞよろしくお願いいたします。

※ご参考までに、こういう処理をしようとしています。
 赤の他人様のコードですが、自分の実コードを持ち出せないので類例でご容赦ください。
http://www.bird-soft.net/mt/2008/07/getpixelexcel-vba.html

Aベストアンサー

目的が画像pixel情報取得だけなら、GDIPlus API可能です。
GdipCreateBitmapFromFile
上記関数にでGdi+用Bitmapハンドルを取得し、
GdipCreateHBITMAPFromBitmap関数でGDI用Bitmapハンドル取得

https://msdn.microsoft.com/en-us/library/windows/desktop/ms533971(v=vs.85).aspx

以後の処理は質問者さんが参考にしている処理と変わらないはずです。
(但しpixel情報取得の文字列経由処理には違和感を感じますが)

※もしUserformに画像表示するのが目的なら話は違いますが。

Qbmp画像をtiff圧縮する方法

VBAを使って、bmp画像をtiff圧縮するプログラムを教えてください。

検索すると

http://oshiete.goo.ne.jp/qa/8508126.html

画像圧縮、変換用のライブラリ を使えば良いという回答ページは見つかったのですが
具体的な方法が分かりません。

「画像 dll vba tif bmp」などで検索してみても分かりませんでしたので
教えてください。

Aベストアンサー

こちらはいかがでしょうか。
http://tanlab.blog.fc2.com/blog-entry-31.html

試してみたところ、ファイル名は、変数に変えてもOKでした。
Dim file1 As String, file2 As String

file1 = "C:\Users\Public\Pictures\Sample Pictures\Hydrangeas.jpg"
file2 = getDeskTopPath & "\test.tif"
(注)getDeskTopPathはデスクトップのパスを取得する自作(というかWebから切り貼りした)関数

GdipCreateBitmapFromFileは、BMP,JPEG,PNG,TIFF等に対応しています。

With encParam.Parameter(0)
    .Value = VarPtr(4) ' 画像圧縮:LZW=2, CCITT3=3, CCITT4=4, Rle=5, None=6
End With
圧縮方法については詳しくは無いですがVarPtr(2)のLZW等にするとカラーになりました。
なお、JPEGからLZW圧縮TIFFに変換したら巨大ファイルになりました。当たり前かも。

こちらはいかがでしょうか。
http://tanlab.blog.fc2.com/blog-entry-31.html

試してみたところ、ファイル名は、変数に変えてもOKでした。
Dim file1 As String, file2 As String

file1 = "C:\Users\Public\Pictures\Sample Pictures\Hydrangeas.jpg"
file2 = getDeskTopPath & "\test.tif"
(注)getDeskTopPathはデスクトップのパスを取得する自作(というかWebから切り貼りした)関数

GdipCreateBitmapFromFileは、BMP,JPEG,PNG,TIFF等に対応しています。

With encParam.Parameter(0)
 ...続きを読む

QACCESSで 実行時エラー2114 画像ファイルが表示できない

 ACCESS初心者です。
tif形式の画像ファイルを表示しようとしたら

実行時エラー2114
ファイルxxx.tifの形式はサポートされていないため、
このピクチャを読み込むことができません。

 というエラーメッセージが出てしまいました。
友人のPCだとエラーメッセージは出ずに正常に画像が表示されました。
(私のPCだけエラーがでます。)

 ファイル->フォルダオプション の関連付けをみても
tifはきちんと関連付けされており、
regeditで HKEY_CLASSES_ROOTをみても正常のように思えます。
そのtifファイルを普通にクリックすると開くことができます。

 何がおかしいのでしょうか?

Aベストアンサー

Microsoft Office Professionalがインストールされているはずですが、TIFF用のグラフィクフィルタがインストールされているかどうか確認してください。これは「コントロールパネル」「アプリケーションの追加と削除」で「Microsoft Office」で追加と削除を選んで「グラフィックフィルタ」のところで確認してみてください。また、Officeのグラフィックフィルタで対応できないTiffの形式があります。もし、そのデータがご友人のPCでお作りになったとすれば、その画像データを作ったグラフィックソフト(編集ソフトかも)が必要になります。PhotoShopやPaintShopProのようなグラフィック専用のアプリではそういったTiff形式にも対応している場合がありますのでインストールしてみるのも手です。

QAccessのRefresh・Requery・Repaintの違い

Requeryはもう一度ソースレコード(テーブル)を読み込むようです。このとき、テーブルの先頭レコードに移動してしまいます。
Refreshは最新のレコード(テーブル)を再表示するような気がします。レコードの移動は起こらない気がします。
Repaintは、VBAでキャプションなどを変更したとき使っています。
でも、よくわかっていません。
どんなときにどんなメソッドを使えばいいのでしょうか?
詳しい方、よろしくお願いいたします。

Aベストアンサー

たびたびすみません。
調べてたらこんなのがでてきました。
http://www.nurs.or.jp/~ppoy/access/access/acF007.html

参考URL:http://www.nurs.or.jp/~ppoy/access/access/acF007.html

QAccessフォームからの外部アプリ起動方法

お世話になります。
掲題の件、Accessのフォームからボタンをクリックし、
外部アプリケーション(たとえばExcel等)を起動する
ことは可能でしょうか?

起動可能であればどのようなVBA記述をしたら良いか
教えて頂けたら幸いです。

[作成環境]
起動ボタン名: 起動
Excelのパス : 
C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE

以上、宜しくお願い致します。

Aベストアンサー

#2 さんで示された、Access クラブに書いてある方法で、オートメーション・オブジェクトを持つアプリケーションは、書いてあるように登録できます。ただし、トラブルがあると常駐してしまいますので、終わったら、必ず、きちんと閉じてください。

>(たとえばExcel等)
ということで、オートメーション・オブジェクトを持たないもの(Office以外)でしたら、以下のように、標準モジュールに書いて、ボタンに登録してみてください。

ファイル名は、確実に設定してください。

Function OpenApp()
Dim rtn As Long
 rtn = Shell("C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE", vbNormalFocus)
End Function

私は、このコードに関して、エラートラップを入れるべきかは分かりません。不安でしたら、Accessクラブのコードを参考に、エラートラップを入れてください。通常、「ファイル名を指定して実行」で開けるようなら、問題はないはずです。

#2 さんで示された、Access クラブに書いてある方法で、オートメーション・オブジェクトを持つアプリケーションは、書いてあるように登録できます。ただし、トラブルがあると常駐してしまいますので、終わったら、必ず、きちんと閉じてください。

>(たとえばExcel等)
ということで、オートメーション・オブジェクトを持たないもの(Office以外)でしたら、以下のように、標準モジュールに書いて、ボタンに登録してみてください。

ファイル名は、確実に設定してください。

Function OpenApp()
Dim rtn ...続きを読む

QACCESS VBA 画像ファイルの大きさ(幅x高さ)を取得したい

ACCESS VBAで画像ファイルの大きさ(バイト数では無く、ピクセル 幅x高さ)を取得したいです。

やりたい事は”スキャナしたA4、A3混在の複数のTIFF形式のファイル(マルチページ形式では無い)をサイズ判別して、それぞれ別レポートで元のサイズで印刷”です。

用紙サイズの判別に上記の 幅x高さを利用しようと考えています。
バイト数の取得(FileLen)の様な単純な方法は無いですか?

いろいろ調べてはみたのですが見付かりませんでした。
初心者ではありますが、どうしても必要なので多少複雑になっても勉強して理解しようと思います。
宜しくお願いします。

Aベストアンサー

確認してみたら LoadPicture では TIF ファイルを読み込めなかったですね。
すみません。JPG や BMP なら大丈夫ですが・・・

TIF に対応した GDI+ を使った方法を改めて紹介します。

Private Declare Function GdiplusStartup Lib "gdiplus" ( _
    ByRef token As Long, _
    ByRef inputBuf As GdiplusStartupInput, _
    ByVal outputBuf As Long) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" ( _
    ByVal token As Long)
Private Declare Function GdipLoadImageFromFile Lib "gdiplus" ( _
    ByVal FileName As Long, _
    ByRef image As Long) As Long
Private Declare Function GdipGetImageDimension Lib "gdiplus" ( _
    ByVal image As Long, _
    ByRef Width As Single, _
    ByRef Height As Single) As Long
    
Private Type GdiplusStartupInput
    GdiplusVersion      As Long
    DebugEventCallback    As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs  As Long
End Type

' // 画像の幅と高さをピクセルで取得する
Public Function GetImageDimensionFromFile( _
  ByVal sImageFilePath As String, _
  ByRef x As Long, _
  ByRef y As Long _
) As Boolean

  '@ 対応フォーマット : BMP, JPG, GIF, TIF, PNG,

  Dim uGdiStartupInput As GdiplusStartupInput
  Dim nGdiToken    As Long
  Dim nStatus     As Long
  Dim hImage      As Long
  Dim xx        As Single
  Dim yy        As Single
  
  x = 0: y = 0
  With uGdiStartupInput
    .GdiplusVersion = 1
  End With
  nStatus = GdiplusStartup(nGdiToken, uGdiStartupInput, 0&)
  If nStatus = 0 Then
    nStatus = GdipLoadImageFromFile(ByVal StrPtr(sImageFilePath), _
                    hImage)
    If nStatus = 0 Then
     nStatus = GdipGetImageDimension(hImage, xx, yy)
     If nStatus = 0 Then
       GetImageDimensionFromFile = True
       x = xx
       y = yy
     End If
    End If
    Call GdiplusShutdown(nGdiToken)
  End If

End Function

Sub sample()

  Dim x  As Long
  Dim y  As Long
 
  If GetImageDimensionFromFile("C:\test3.tif", x, y) Then
    MsgBox CStr(x) & " x " & CStr(y) & " pix"
  Else
    MsgBox "失敗"
  End If

End Sub

確認してみたら LoadPicture では TIF ファイルを読み込めなかったですね。
すみません。JPG や BMP なら大丈夫ですが・・・

TIF に対応した GDI+ を使った方法を改めて紹介します。

Private Declare Function GdiplusStartup Lib "gdiplus" ( _
    ByRef token As Long, _
    ByRef inputBuf As GdiplusStartupInput, _
    ByVal outputBuf As Long) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" ( _
    ByVal token As Long)
Private Declare Function GdipLoa...続きを読む

Qビデオファイルのプロパティの値を取得する方法

ビデオファイルのプロパティの詳細で表示されるプロパティの値(名前、日付時刻、種類、サイズ、長さ、ビットレートなど)をExcelに取り込んで管理したいのですが、どのようにすればよいのでしょうか?

Aベストアンサー

この方法で
全てのプロパティが取得できそうです。
Sub ボタン1_Click()
Dim Shell, Folder
Set Shell = CreateObject("Shell.Application")
Set Folder = Shell.Namespace(Range("A1").Value)
Fil = Dir(Range("a1").Value & "\*.*")
Rows("5:65536").ClearComments
i = 5
Do While Fil <> ""
For j = 0 To 40
Cells(i, j + 1).Value = Folder.GetDetailsOf(Folder.ParseName(Fil), j)
Next
i = i + 1
Fil = Dir()
Loop
Set Folder = Nothing
Set Shell = Nothing
End Sub
不要な列は非表示にデモしてください。
列に何が表示されているかの項目がすべては調べきれませんでしたが
そちらのデータと比較して5行目に項目を入れてください。

この方法で
全てのプロパティが取得できそうです。
Sub ボタン1_Click()
Dim Shell, Folder
Set Shell = CreateObject("Shell.Application")
Set Folder = Shell.Namespace(Range("A1").Value)
Fil = Dir(Range("a1").Value & "\*.*")
Rows("5:65536").ClearComments
i = 5
Do While Fil <> ""
For j = 0 To 40
Cells(i, j + 1).Value = Folder.GetDetailsOf(Folder.ParseName(Fil), j)
Next
i = i + 1
Fil = Dir()
Loop
Set Folder = Nothing
Set Shell = Nothing
End Sub
不要な列は非表示にデモし...続きを読む


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

人気Q&Aランキング