Excel VBA質問箱 IV

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

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


63099 / 76738 ←次へ | 前へ→

【18238】Re:プリンタ一覧の取得
発言  shousuke WEB  - 04/9/18(土) 23:55 -

引用なし
パスワード
   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 質問
【18186】Re:プリンタコードの取得 IROC 04/9/17(金) 14:14 回答
【18187】Re:プリンタコードの取得 kuma 04/9/17(金) 15:41 発言
【18188】Re:プリンタコードの取得 IROC 04/9/17(金) 16:32 回答
【18192】Re:プリンタコードの取得 ichinose 04/9/17(金) 18:25 発言
【18214】Re:プリンタコードの取得 訂正 ichinose 04/9/18(土) 13:25 発言
【18238】Re:プリンタ一覧の取得 shousuke 04/9/18(土) 23:55 発言
【18239】Re:プリンタ一覧の取得 shousuke 04/9/18(土) 23:58 発言
【18314】Re:プリンタ一覧の取得 kuma 04/9/21(火) 11:44 お礼
【18358】Re:プリンタ一覧の取得 ichinose 04/9/21(火) 22:11 発言
【18431】Re:プリンタ一覧の取得 shousuke 04/9/23(木) 18:27 お礼
【18585】Re:プリンタ一覧の取得 kuma 04/9/30(木) 12:15 お礼

63099 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free