Excelで用紙番号を取得する方法

このQ&Aのポイント
  • Excel2000 VBAで用紙番号を取得する方法について調査中です。APIのDeviceCapabilities()を使用する方法もあるようですが、バッファの使い方がわかりません。
  • Excel2000で上記コードを実行するとエラーになります。おそらくバッファの使い方が間違っている可能性があります。
  • アドバイスをいただけると助かります。
回答を見る
  • ベストアンサー

Excelで用紙番号取得

Excel2000 VBAで用紙番号を取得しようと考えています。 調べてみたのですが、APIのDeviceCapabilities()が使用できそうな感じというのは解ったのですが、 バッファというのがいまいち解らず使えません。 出力バッファやデバイスデータのバッファとは何を指してるのでしょうか? また、以下コードをExcel2000で実行するとエラーになります。 やはりバッファの使い方がおかしいのでしょうか? アドバイスよろしくお願いいたします。 Sub Numbertest() Dim strDeviceName As String Dim strDevicePort As String Dim lngPaperCount As Long Dim bytPaper() As Byte Dim strPaperName As String * 64 Dim lngCounter As Long Dim aintNubytPaper() As Integer Dim lngRet As Long GetPrinterNameAndPort sDeviceName, sDevicePort ' バッファに必要なサイズを取得 lngPaperCount = DeviceCapabilities(strDeviceName, strDevicePort, DC_PAPERNAMES, ByVal vbNullString, ByVal vbNullString) ' バッファ確保 ReDim bytPaper(64 - 1, lngPaperCount - 1) ReDim aintNubytPaper(1 To lngPaperCount) '用紙名を取得 DeviceCapabilities strDeviceName, strDevicePort, DC_PAPERNAMES, bytPaper(0, 0), ByVal vbNullString 'paper numbers を取得 lngRet = DeviceCapabilities(strDeviceName, strDevicePort, DC_PAPERS, aintNubytPaper(1), ByVal vbNullString) '用紙名を列挙 For lngCounter = 0 To lngPaperCount - 1 ' 用紙名コピー MoveMemory ByVal strPaperName, bytPaper(0, lngCounter), 64 ' 用紙名追加 MsgBox aintNubytPaper(lngCounter + 1) MsgBox Left(strPaperName, InStr(strPaperName, vbNullChar) - 1) Next lngCounter End Sub

質問者が選んだベストアンサー

  • ベストアンサー
  • kmetu
  • ベストアンサー率41% (562/1346)
回答No.1

変数名とかのミスタイプだと思われるところもありますが どういったエラーがでてるのでしょうか APIを利用するための Private Declare Function なんかの宣言はされてますか?

abuhiro
質問者

補足

返信ありがとうございます。 始めに、携帯からなのでコピペ出来ませんm(__)m エラー場所は バッファ確保の二行です。 バッファの仕組みがイマイチ理解出来てませんm(__)m API関数の引数に、バッファ用変数を入れて、そこに結果を出力して下さい と言った解釈で良いのでしょうか?

その他の回答 (2)

  • watabe007
  • ベストアンサー率62% (476/760)
回答No.3
  • kmetu
  • ベストアンサー率41% (562/1346)
回答No.2

> エラー場所は > バッファ確保の二行です。 その内容はどのようなものなのでしょうか また、あなたが参考にしたページの説明ではどのようなことが書かれていたのでしょうか バッファとは一時的なデータの保管場所のことをいいます。

abuhiro
質問者

補足

アドバイスありがとうございます。 バッファ確保の所で、 『インデックスが有効ではありません』 と出ます。 配列の要素数が不足しているのは解るのですが、バッファの仕組みが解らない為、いくつにして良いのか???です。 バイト型の配列みたいなのですが、APIの関数がどの様な戻り値なのかも解りません。 参考にしたサイトは複数あり、ミックスしてアレンジしました。 基本VBAでの解説サイトが見つけられず、VBのサイトを参考にしました。 VBAでの用紙番号の取得方法が載っているサイトをご存知でしたら、リンクよろしくお願いします。 用紙が新しく作った専用用紙なので、それに印刷する事が目的です。 夕方まで、返信は携帯からなので、文面が見にくいと思いますが、ご容赦ですm(__)m

関連するQ&A

  • プリントサーバーに登録してある用紙サイズの取得

    いつもご参考にさせて頂いております。 現在Accessにて印刷を行っています。 そこで現状Accessを立ち上げた時に用紙サイズとそのIDを取得する様にしていますが、通常使うプリンタの用紙サイズしか見に行きません。 プリントサーバーにある全ての用紙サイズとIDを取得する方法はあるのでしょうか? どなたかご教授宜しくお願い致します。 OS:Vista , Access2007 プリンタはドットとレーザーを使用しています。 もし下記以外にもっといい方法があれば、是非ご教授宜しくお願い致します。 'プリンタデバイスドライバの能力を取得する関数の宣言 Private Declare Function DeviceCapabilities Lib "winspool.drv" Alias "DeviceCapabilitiesA" (ByVal pDevice As String, ByVal pPort As String, ByVal fwCapability As Long, pOutput As Any, pDevMode As Any) As Long 'ある位置から別の位置にメモリブロックを移動する関数の宣言 Private Declare Sub MoveMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) 'DeviceCapabilities function constants. Private Const DC_PAPERNAMES = 16 Private Const DC_PAPERS = 2 Private Const DC_BINNAMES = 12 Private Const DC_BINS = 6 Private Const DEFAULT_VALUES = 0 Private Sub Form_Load() Dim strDeviceName As String Dim strDevicePort As String Dim lngPaperCount As Long Dim bytPaper() As Byte Dim strPaperName As String * 64 Dim lngCounter As Long Dim aintNubytPaper() As Integer Dim lngRet As Long Dim db As Database Dim rs As Recordset '用紙サイズと番号を保存するテーブルの削除 DoCmd.RunSQL "DELETE * FROM [T_PaperSize]" Set db = CurrentDb Set rs = db.OpenRecordset("T_PaperSize") With Printer strDeviceName = .DeviceName strDevicePort = .Port End With '問い合わせる内容を指定 'バッファに必要なサイズを取得 lngPaperCount = DeviceCapabilities(strDeviceName, strDevicePort, DC_PAPERNAMES, _ ByVal vbNullString, ByVal vbNullString) ' バッファ確保 ReDim bytPaper(64 - 1, lngPaperCount - 1) ReDim aintNubytPaper(1 To lngPaperCount) '用紙名を取得 DeviceCapabilities strDeviceName, strDevicePort, DC_PAPERNAMES, bytPaper(0, 0), ByVal vbNullString '用紙IDを取得 lngRet = DeviceCapabilities(strDeviceName, strDevicePort, DC_PAPERS, aintNubytPaper(1), ByVal vbNullString) '用紙名を検索 For lngCounter = 0 To lngPaperCount - 1 '用紙名コピー MoveMemory ByVal strPaperName, bytPaper(0, lngCounter), 64 ' 用紙名追加 'Debug.Print Left(strPaperName, InStr(strPaperName, vbNullChar) - 1) & " " & aintNubytPaper(lngCounter + 1) rs.AddNew rs![ID] = aintNubytPaper(lngCounter + 1) rs![用紙名] = Left(strPaperName, InStr(strPaperName, vbNullChar) - 1) rs.Update Next lngCounter End Sub

  • ExcelでDeviceCapabilitie

    ExcelでAPIを使用して、用紙番号を取得したいと考えています。 Excel2007(OS Win7)上では取得できるのですがExcel2000(OS WinXP)上ではエラー。 GetPrinterNameAndPortで、『 on 』と『 の 』がバージョンによって変えてもダメでした。アドバイスよろしくお願い致します。 Private Declare Function DeviceCapabilities Lib "winspool.drv" Alias "DeviceCapabilitiesA" (ByVal pDevice As String, ByVal pPort As String, ByVal fwCapability As Long, pOutput As Any, pDevMode As Any) As Long Private Declare Sub MoveMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Const DC_PAPERNAMES = 16 Private Const DC_PAPERS = 2 Private Const DC_BINNAMES = 12 Private Const DC_BINS = 6 Private Const DEFAULT_VALUES = 0 Sub Numbertest() Dim strDeviceName As String Dim strDevicePort As String Dim lngPaperCount As Long Dim bytPaper() As Byte Dim strPaperName As String * 64 Dim lngCounter As Long Dim aintNubytPaper() As Integer Dim lngRet As Long GetPrinterNameAndPort strDeviceName, strDevicePort lngPaperCount = DeviceCapabilities(strDeviceName, strDevicePort, DC_PAPERNAMES, ByVal vbNullString, ByVal vbNullString) ReDim bytPaper(64 - 1, lngPaperCount - 1) ReDim aintNubytPaper(1 To lngPaperCount) DeviceCapabilities strDeviceName, strDevicePort, DC_PAPERNAMES, bytPaper(0, 0), ByVal vbNullString lngRet = DeviceCapabilities(strDeviceName, strDevicePort, DC_PAPERS, aintNubytPaper(1), ByVal vbNullString) For lngCounter = 0 To lngPaperCount - 1 MoveMemory ByVal strPaperName, bytPaper(0, lngCounter), 64 MsgBox aintNubytPaper(lngCounter + 1) & " & " & Left(strPaperName, InStr(strPaperName, vbNullChar) - 1) Next lngCounter End Sub Private Sub GetPrinterNameAndPort(printerName As String, printerPort As String) Dim sString As String Const searchText As String = " on " ←使い分け ' Const searchText As String = " の " sString = ActivePrinter printerName = Left(sString, InStr(1, sString, searchText) - 1) printerPort = Right(sString, Len(sString) - Len(printerName) - Len(searchText)) End Sub

  • アクセスでテキストを開く

    アクセスでパスを指定して、特定のテキストファイルを開く方法を教えていただけますか? いかのモジュールを見つけたのですが、どこに、動かないか… フルパスを入れればよいか分かりません。 どうぞ宜しくお願いします。 *********************************************************************************************** Private Declare Function ShellExecute Lib "SHELL32.DLL" Alias "ShellExecuteA" (ByVal hwnd As Long, _ ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _ ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Private Sub コマンド0_Click() Dim strFilePath As String Dim lngRet As Long Const SW_SHOWNORMAL = 1 strFilePath = Me.txt_Path 'WinAPIを使って関連付けられたアプリケーションを起動 lngRet = ShellExecute(Application.hWndAccessApp, "OPEN", _ strFilePath, vbNullString, CurDir(), SW_SHOWNORMAL) If lngRet <= 32 Then '返り値が 32 以下の場合はエラー MsgBox "ファイルを開けません!", vbOKOnly + vbExclamation End If End Sub ***********************************************************************************************

  • アクティブなプリンターでサポートされている用紙名

    http://support.microsoft.com/kb/229718/ja で「アクティブなプリンターでサポートされている用紙名の一覧を取得するマクロ」を見つけたので自分の環境で実行してみました。 OS:Windows XP SP3 アプリケーション: エクセル2002(SP3) 結果はメッセージボックスが表示されるのですが、用紙名のリストが数文字ずつ少なり、リストの最後は「 ) 」の一文字だけになります。またプリンタードライバーがリストする用紙の種類よりも少なくなっています。文字数がなくなったのだと思いますが・・・・・ active printerを取得→そのプリンタードライバを開く→ドライバーが持っている用紙の数を取得→For~Nextでテキストに追加→メッセージボックスで表示しているだろうことはわかるのですが、得られる結果(用紙名の文字数が減少する)がわかりません。 どこをどのように直せば用紙名(できれば「サイズ」「用紙名の番号」も)取得できるでしょうか? さらに言えば、メッセージボックスでなくワークシートのセルに書き出したいです。 お知恵をお貸しください。 該当のコードは以下のとおりです。 Option Explicit Private Declare Function OpenPrinter Lib "winspool.drv" Alias _ "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, _ ByVal pDefault As Long) As Long Private Declare Function ClosePrinter Lib "winspool.drv" ( _ ByVal hPrinter As Long) As Long Private Declare Function DeviceCapabilities Lib "winspool.drv" _ Alias "DeviceCapabilitiesA" (ByVal lpsDeviceName As String, _ ByVal lpPort As String, ByVal iIndex As Long, lpOutput As Any, _ ByVal dev As Long) As Long Private Const DC_PAPERNAMES = 16 ' Value obtained from wingdi.h Sub GetPaperList() ' Display a message box with the name of the active printer and a list ' of papers it supports. Dim lPaperCount As Long Dim lCounter As Long Dim hPrinter As Long Dim sDeviceName As String Dim sDevicePort As String Dim sPaperNamesList As String Dim sNextString As String Dim sTextString As String Dim iNumPaper() As Integer GetPrinterNameAndPort sDeviceName, sDevicePort If OpenPrinter(sDeviceName, hPrinter, 0) <> 0 Then ' Get count of paper names supported by active printer. lPaperCount = DeviceCapabilities(sDeviceName, _ sDevicePort, _ DC_PAPERNAMES, _ ByVal vbNullString, 0) ReDim iNumPaper(1 To lPaperCount) sPaperNamesList = String(64 * lPaperCount, 0) ' Get paper names supported by active printer. lPaperCount = DeviceCapabilities(sDeviceName, _ sDevicePort, _ DC_PAPERNAMES, _ ByVal sPaperNamesList, 0) ' List available paper names. sTextString = "Paper available for " & ActivePrinter For lCounter = 1 To lPaperCount ' Get a paper name. sNextString = Mid(sPaperNamesList, _ 64 * (lCounter - 1) + 1, 64) sNextString = Left(sNextString, _ InStr(1, sNextString, Chr(0)) - 1) ' Have one paper name. sNextString = String(6 - Len(CStr(iNumPaper(lCounter))), _ " ") & sNextString ' Add paper name to text string for message box. sTextString = sTextString & Chr(13) & sNextString Next lCounter ClosePrinter (hPrinter) ' Show paper names in message box. MsgBox sTextString Else MsgBox ActivePrinter & " <Unavailable>" End If End Sub Private Sub GetPrinterNameAndPort(printerName As String, _ printerPort As String) ' ActivePrinter yields a name of the form "Printer XYZ on LPT1" while the ' DeviceCapabilities function requires a printer name and port. ' ' Out: ' printerName Printer name derived from ActivePrinter property ' printerPort Printer port derived from ActivePrinter property Dim sString As String Const searchText As String = " on " sString = ActivePrinter printerName = Left(sString, InStr(1, sString, searchText) - 1) printerPort = Right(sString, _ Len(sString) - Len(printerName) - Len(searchText)) End Sub ※support.microsoft.comのサンプルコードなのに・・・・

  • フォルダーの中に特定ファイルを開くの続きですが

    フォルダーの中に特定ファイルを開くの続きですが 次の命令を書きましたが実行できないです。間違った所を教えてほしいです 見積番号とはフォームの中のテキストボックスです。それをクリックする関連するエクセルファイルが開くようにしたいですのでよろしくお願いします。 Private Sub 見積番号_Click() Dim LngRet As Long Dim stLinkCriteria As String Dim Ipath As String Ipath = "\\C:\全社員共通\[見積書]\見積\" stLinkCriteria = Ipath & "\" & 見積番号 & "*.xls" LngRet = ShellExecute(0, vbNullString, Ipath & stLinkCriteria, _ vbNullString, vbNullString, 1) End Sub

  • エクセル(複数インスタンス)より任意のWorkBookを取得したい

    VB初心者です。非常に困っていますのでどうぞ宜しく御願いいたします。  起動中のエクセルをVB6.0からコントロールしたいと思い、以下のコードを書いたのですが、エクセルが複数インスタンスで起動している場合、意図するワークブックが取得できないことに気が付きました。(一番初めに起動したインスタンスのエクセルしか取得できませんでした) ■失敗■ Private Sub Command1_Click()  Set xlApp = GetObject(, "Excel.Application")  xlApp.ActiveWorkbook.Sheets("シート名").Select 'アクティブなWorkBookを取得  Err.Clear  On error resume next  If Err.Number <> 0 Then  MsgBox"エラー"  Else  msgBox"取得成功"  End If  Err.Clear  On error goto 0 End Sub  そこで、全てのエクセルのウィンドーテキストを取得し、そこから意図するエクセルオブジェクトを取得しようと、ネットで調べながら以下のプログラムを試してみました。結果、List1に全てのインスタンスのワークブック名を取得することはできましたが、肝心のGetObjectで「オートメンーションの操作中にファイル名またはクラス名を見つけられませんでした。」というエラーが発生し失敗してしまいました。 ■失敗■ 'Windowの生成API Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long Private Sub Command1_Click() 'コントロールするエクセルの列挙 Dim lBookNameLenghth As Long Dim strBuffer As String Dim lChild As Long Const lBufferSize As Byte = 255 strBuffer = String(lBufferSize, Chr(0)) List1.Clear Do Counter = Counter + 1 lChild = FindWindowEx(0, lChild, "MS-SDIa", vbNullString) If lChild = False Then Exit Do lBookNameLenghth = GetWindowText(lChild, strBuffer, lBufferSize) List1.AddItem Left(strBuffer, lBookNameLenghth) Loop While lChild End Sub Private Sub List1_Click() If List1.Text <> "" Then Set xlApp = GetObject(List1.Text, "Excel.Application") '←ここでエラー発生 End If End Sub どんな方法でも構いませんので、全てのインスタンスのエクセルを対象としたエクセルオブジェクト取得方法を教えてください。 環境:Windows2000 Professional+VB6.0+Office2000 以上、宜しく御願いいたします。

  • VB6 OpenPrinterのエラー

    OS:WindowsXP SP3 言語:VB6 SP6 現在、指定されたプリンタのジョブを取得して、全てジョブを一時停止にするプログラムを作っています。 下記コードはタイマーイベントで実行されるコードなのですが、、、 「lngRet = OpenPrinter(mPrinterName, hPrinter, ByVal 0&)」の部分で、 アプリケーションエラー(※添付画像参照)が発生してしまいます。 最初のうちは発生しませんが、数秒後にエラーになります。(タイマー間隔は0.5秒に設定) 内容をご存知の方がいましたら教えていただけないでしょうか? 宜しくお願い致します。 ------------------------------------------------------------- Dim lngRet As Long Dim i As Integer Dim intRow As Integer Dim lngTypeLen As Long Dim hPrinter As Long Dim Level As Long Dim bytJob() As Byte Dim dwNeeded As Long Dim dwReturned As Long Dim lngJobID() As Long Dim udtJobInfo1() As JOB_INFO_1 Dim ftDate As FILETIME Dim ltDate As FILETIME Dim stDate As SYSTEMTIME Dim udtPrinterDefaults As PRINTER_DEFAULTS '初期化 Call PgdGrid.RemoveItems(0, PgdGrid.Items) PgdGrid.Enabled = False Erase lngJobID 'プリンタアクセス権 udtPrinterDefaults.DesiredAccess = PRINTER_ALL_ACCESS 'プリンタをオープンし、プリンタのハンドルを取得 ↓エラーになる********************************** lngRet = OpenPrinter(mPrinterName, hPrinter, ByVal 0&) ↑エラーになる********************************** 'まずEnumJobsを実行し、必要なメモリサイズ(バッファのバイト数)を調べる lngRet = EnumJobs(hPrinter, 0&, &HFFFFFFFF, 1&, ByVal 0&, 0&, dwNeeded, dwReturned) If dwNeeded = 0& Then Call ClosePrinter(hPrinter) Exit Sub End If '配列初期化 ReDim bytJob(dwNeeded - 1) '実際のデータを取得するために関数を実行 lngRet = EnumJobs(hPrinter, 0, &HFFFFFFFF, 1, bytJob(0), dwNeeded, dwNeeded, dwReturned) '配列初期化 ReDim udtJobInfo1(dwReturned - 1) ReDim lngJobID(dwReturned - 1) For i = 0 To dwReturned - 1 Call MoveMemory(udtJobInfo1(i), bytJob(Len(udtJobInfo1(0)) * i), Len(udtJobInfo1(0))) lngJobID(i) = udtJobInfo1(i).JobId lngRet = OpenPrinter(mPrinterName, hPrinter, udtPrinterDefaults) 'ジョブの状態を一時停止にする If (udtJobInfo1(i).Status And JOB_STATUS_PAUSED) Or (udtJobInfo1(i).Priority = 2) Then '一時停止 or 本PGで既に設定したものは状態を変えない Else '優先順位を変える(フラグ) udtJobInfo1(i).Priority = 2 lngRet = SetJob(hPrinter, lngJobID(i), 1, ByVal udtJobInfo1(i), JOB_CONTROL_PAUSE) If lngRet = 0 Then 'エラー MsgBox GetLastErrorMessage(GetLastError) End If '一時停止にする lngRet = SetJob(hPrinter, lngJobID(i), 0&, 0&, JOB_CONTROL_PAUSE) If lngRet = 0 Then 'エラー MsgBox GetLastErrorMessage(GetLastError) End If End If 'プリンタをクローズ Call ClosePrinter(hPrinter) Next i -------------------------------------------------------------

  • VB.NETでのiniファイル読込について。

    .netでのiniファイル読込がうまくいきません。 何が悪いのかさっぱりわかりません。 ご指摘お願いいたします。 環境 os :xp 開発ソフト VB.NET ver 1.1.4322 SP1 ソース Private Declare Function GetPrivateProfileString Lib "kernel32" _ Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _ ByVal lpKeyName As String, _ ByVal lpDefault As String, _ ByVal lpReturnedString As String, _ ByVal nSize As Long, _ ByVal lpFileName As String) As Long '実行ファイルパスの取得 *VB6のapp.path Shared Function GetAppPath() As String Return System.IO.Path.GetDirectoryName( _ System.Reflection.Assembly.GetExecutingAssembly().Location) End Function Function INI_DBPATH_READ(ByVal FilePath As String) As String Dim lngRet As Long   '読み込みバッファ(固定長) Dim strGetBuff As String = 256   'iniファイルより読み込む文字列のサイズ Dim intGetSize As Integer   'セクション名 Dim strSection As String   'キー名 Dim strKey As String   '読み込みエラー時の出力文字列 Dim strErr As String   'iniファイル名(フルパス) Dim striniFn As String strGetBuff = Space(256) strSection = "TIFF_FOLDER" strKey = "PATH" strErr = "失敗" striniFn = Replace(GetAppPath(), "\bin", "\Ini") & "\test.ini" intGetSize = 256 'strGetBuffに文字列を取得する lngRet = GetPrivateProfileString(strSection, strKey, strErr, _ strGetBuff, intGetSize, striniFn) '末尾のNull除去 MsgBox(Microsoft.VisualBasic.Left(strGetBuff, InStr(strGetBuff, Chr(0)) - 1)) End Function iniファイルの内容 [TIFF_FOLDER] PATH=成功

  • APIを使う時は参照設定は不要?

    例えば Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Sub test() Dim Handle As Long Handle = FindWindow("IEFrame", vbNullString) Debug.Print Handle End Sub と言うコードでウィンドウハンドルを取得する場合、 参照設定のどこにもチェックを入れませんが、なぜ参照設定しなくても使えるのでしょうか? Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long が参照設定の代わりになるのですか?

  • 引数で戻り値を取得するプログラム

    以下のように、引数で戻り値を取得するプログラムを書きたいのですが どのように書けば正しいでしょうか? VB6とVB2005の両方の書き方を教えてください。 sub kekka(byval src as string, byref dst() as string) dim ret() as string ret(0) = "abc" ret(1) = "efg" kekka = ret end sub kekka("xxx", dat() ) msgbox(dat(0)) msgbox(dat(1))