| |
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
|
|
shousuke
- 04/9/18(土) 23:55 -
