Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

62980 / 76738

←次へ　｜　前へ→


	【18358】Re:プリンタ一覧の取得

ichinose - 04/9/21(火) 22:11 -


	引用なし

	パスワード

▼shousuke さん：
こんばんは。あー、こっちの方が断然速いですね！！
ＡＰＩ宣言が抜けていたので、
Public Declare Function GetProfileString Lib "kernel32" Alias _
　　　　 "GetProfileStringA" (ByVal lpAppName As String, _
　　　　　　　　　　　　　　　ByVal lpKeyName As String, _
　　　　　　　　　　　　　　　ByVal lpDefault As String, _
　　　　　　　　　　　　　　　ByVal lpReturnedString As String, _
　　　　　　　　　　　　　　　ByVal nSize As Long) As Long

>Public Sub プリンタ名設定()
'Sheets("List").Select　これでアクティブシートに表示されますね？
>ActiveSheet.Range("E3:E20").ClearContents
>ActiveSheet.Range("E3").Select
>
>Dim vntArray As Variant, Element As Variant
>Dim intCount As Integer, strPrinter As String, intPos As Integer, strPort As String
>
>'エントリ検索
>vntArray = API_GetProfileString("Devices", vbNullString, "NotFound", 1024, Chr(0))
>
>If IsEmpty(vntArray) = False Then
>
>　　For intCount = LBound(vntArray) To UBound(vntArray)
>　　　　
>　　　　'キー検索
>　　　　strPrinter = vntArray(intCount)　　　　　　　　　　　　　　　　　　　'プリンタ名
>　　　　Element = API_GetProfileString("Devices", strPrinter, "NotFound", 1024, Chr(0))
>　　　　
>　　　　If IsEmpty(Element) = False Then
>　　　　　　
>　　　　　　intPos = InStr(1, Element(0), ",")　　　　　　　　　　　　　　
>'区切り文字（,）位置
>　　　　　　If intPos <> 0 Then strPort = Mid(Element(0), intPos + 1, Len(Element(0)) - intPos)
>　　　　　　
>　　　　　　　　'====================
>　　　　　　　　Debug.Print strPort & " on " & strPrinter
>　　　　　　　　'====================
>'アクティブなセルへプリンタ名を代入する
>　　　　　
>　　　　　　　　ActiveCell = strPrinter & " on " & strPort
>　　　　　　　　ActiveCell.Offset(1, 0).Select 'アクティブセルの移動
>　　　　　　　　　　　　　　　　　
>　　　　　　　　　　
>　　　　　　End If
>　　
>　　　Next intCount
>　　
>End If
>
>End Sub
>
>
>'以下は関数＊＊＊
>Public Function API_GetProfileString(strAppName As String, strKeyName As String, strDefault As String, _
>　　lngSize As Long, strDelimiter As String) As Variant
>
>Dim strBuf As String　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　'情報を取得するためのバッファ
>Dim lngResult As Long　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 '戻り値
>Dim lngStart As Long, lngPos As Long
>Dim strTemp As String, strArray() As String, intCount As Integer
>
>'On　Error Resume Next
>
>　　'---------------------------------------------------------------------------
>　　'関数の呼び出し
>　　'---------------------------------------------------------------------------
>　　'WIN.INI からの情報を取得するためのバッファ
>　　strBuf = Space(lngSize)
>　　
>　　'WIN.INI から指定したエントリないでキーを検索、該当データのバイト数を返す
>　　lngResult = GetProfileString(strAppName, strKeyName, strDefault, strBuf, lngSize)
>　　
>　　'戻り値（テンポラリ）
>　　strTemp = Trim(Left(strBuf, lngResult))
>　　
>　　'---------------------------------------------------------------------------
>　　'戻り値チェック
>　　'---------------------------------------------------------------------------
>　　If strTemp = Empty Then API_GetProfileString = Empty: Exit Function　　　　 'キーなし時
>　　If strTemp = strDefault Then API_GetProfileString = Empty: Exit Function　　'該当なし時
>　　
>　　lngStart = 1: intCount = Empty
>　　
>　　'**********
>　　'複数戻り値の場合のチェック
>　　Do
>　　　　lngPos = InStr(lngStart, strTemp, strDelimiter)　　　　　　　　　　　　 'データ区切り位置検出
>　　　　
>　　　　If lngPos = 0 And (lngStart > 1) Then Exit Do　　　　　　　　　　　　　 'データ区切りなし時終了
>　　　　
>　　　　If Mid(strTemp, lngStart, 1) <> strDelimiter Then
>　　　　　　
>　　　　　　'区切られたデータを配列に格納
>　　　　　　ReDim Preserve strArray(intCount) As String
>　　　　　　If lngPos = 0 Then
>　　　　　　　　strArray(intCount) = strTemp
>　　　　　　Else
>　　　　　　　　strArray(intCount) = Mid(strTemp, lngStart, lngPos - lngStart)
>　　　　　　End If
>　　　　
>　　　　End If
>　　　　
>　　　　lngStart = lngPos + 1　　　　　　　　　　　　　　　　　　　　　　　　　 '検索開始位置
>　　　　intCount = intCount + 1　　　　　　　　　　　　　　　　　　　　　　　　 '配列の要素インデックス増
>　　　　
>　　Loop Until lngPos = 0
>　　'**********
>　　
>　　'戻り値
>　　API_GetProfileString = strArray
>　　
>End Function

処理が速いのに活用されないといけないので、コメントしておきます。

1 hits

▼

【18184】プリンタコードの取得 kuma 04/9/17(金) 11:54