| |
▼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
処理が速いのに活用されないといけないので、コメントしておきます。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 04/9/18(土) 23:55 -
