特化した Excel Ribbon

Home

(2)ActivePrinter

まえがき

　

特化したExcel Ribbon Codeを公開しています。
動作確認はしていますが、公開コードは私の知識範囲なので、
最良のコードでないかもしれません。

　　 

(1)動的ドロップダウンリスト

(2)アクティブプリンターの選択

-----------------------------------------------------------

Office Ribbon Editorでリボンコード作成をしています。
Editor導入及び基本操作は下記記事参照より省いています。

　

きぬあさ氏のリボン関連記事
　 初心者備忘録のホームページ
-----------------------------------------------------------

（1）dynamic(動的) DropDownList

　

ダウンロードファイルを用意しましたので、
動作確認は、そちらのファイルで確認願います。
64bitでエラーが有りましたので再アップです。
　　　 又表示コードは64bit対応では有りません。

※ダウンロードファイル   dropdownlist_Ribbon.zip

 
<?xml version="1.0" encoding="utf-8"?> 
<!--Ribbonx12 2007-->
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
<!--Ribbonx14 2010-->
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui"> 
　　<ribbon startFromScratch="false">
    　<tabs>
      　<tab id="myTab" label="MyTab">
        　<group id="Group1" label="検索">
          　<dropDown id="Search"  sizeString="WWWWWW"
　　　　　　　getItemCount="ItemCount"
　　　　　　　getItemLabel="ListItem"
　　　　　　　onAction="search"/>
　　　　　</group>
      　</tab>
    　</tabs>
　　</ribbon>
</customUI> 
      

Option Explicit
'シートがアクティブ時にドロップダウンにリストを追加
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim control As IRibbonControl
    Call ReListItem(control)
End Sub
      

Option Explicit
Option Private Module

Public myRibbon As IRibbonUI
Private returnedVal As Variant
Private SaimokuName() As String  '細目名
Private ItemCnt As Long
Private IndexOfSelectedItem As Integer

''-------  Dropdown Callback Code --------
Sub MyAddInInitialize(Ribbon As IRibbonUI)
    Set myRibbon = Ribbon
End Sub

Sub ItemCount(control As IRibbonControl, ByRef returnedVal) 'ItemCount
    Call GetSaimoku  '細目名の配列
    If Sgn(SaimokuName) = 0 Then
        returnedVal = 0
    Else
        ItemCnt = UBound(SaimokuName)  '上記配列の要素数
        returnedVal = ItemCnt
    End If
End Sub

Sub ListItem(control As IRibbonControl, index As Integer, _ 
             ByRef returnedVal) 'ItemAdd
    If IsArray(SaimokuName) = False Then
    Else
        returnedVal = SaimokuName(index + 1) '配列をItemに追加
    End If
End Sub

Sub search(control As IRibbonControl, id As String, index As Integer) 
　　'Selectのインデックス
    Dim buf As Variant
    IndexOfSelectedItem = index + 1
    buf = SaimokuName(IndexOfSelectedItem)
    Call SearchSaimoku(buf)
End Sub

Sub ReListItem(control As IRibbonControl)
    Erase SaimokuName
    myRibbon.InvalidateControl "Search"
End Sub
'------------------------------------------

Private Sub GetSaimoku()
'****************************************************
'各シートをアクティブにした時Ａ列に"*"が有る場合
'配列に"*"行の名称をAddItemする
'****************************************************
    Dim myCnt As Long
    Dim myRng As Range
    Dim n As Integer
   
    Set myRng = ActiveSheet.Columns("A")
    myCnt = WorksheetFunction.CountIf(myRng, "*")
    ReDim SaimokuName(myCnt)
    
    If myCnt <> 0 Then
        n = 0
        For Each myRng In ActiveSheet.Range("A1", _ 
                                      Range("A65536").End(xlUp))
            If myRng.Value = "*" Then
                n = n + 1
                SaimokuName(n) = myRng.Offset(0, 2).Value
'                Debug.Print SaimokuName(n), n
            End If
        Next
    Else
        Erase SaimokuName
    End If
End Sub

Private Sub SearchSaimoku(buf As Variant)
'****************************************************
'細目bufをサーチして 画面をスクロールする
'****************************************************
     Dim myRng As Range
     Dim IndexNo As Integer
     Dim firstaddress As String
 
    If buf <> "" Then
        Set myRng = Columns("A").Find(What:="*", After:=Range("A1"), _
                    LookIn:=xlValues, searchdirection:=xlNext)
        If Not myRng Is Nothing Then
            firstaddress = myRng.Address
            Do
                If myRng.Offset(0, 2) = buf Then GoTo Nextline
                Set myRng = Columns("A").FindNext(After:=myRng)
            Loop While Not myRng Is Nothing And _ 
                           myRng.Address <> firstaddress
            Exit Sub
        End If
Nextline:
       Application.Goto reference:=Range(myRng.Address).Offset(0, 0), _ 
                                    Scroll:=True
        myRng.Offset(0, 2).Select
    End If
End Sub     
      

（2）ActivePrinter Select

　

ダウンロードファイルを用意しましたので、
動作確認は、そちらのファイルで確認願います。
その後64bit対応を作成しました。
　　　　又表示コードは64bit対応では有りません。

※ダウンロードファイル   Printer_Ribbon(64bit).zip

      
 <?xml version="1.0" encoding="UTF-8"?>
<!--Ribbonx12 2007-->
<customUI xmlns= "http://schemas.microsoft.com/office/2006/01/customui"> 
<!--Ribbonx14 2010-->
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">  
  <ribbon startFromScratch="false">
    <tabs>
      <tab id="myTab" label="MyTab">
        <group id="myGroup1" label="印刷">
          <button id="button1" label="印刷　　" 
		imageMso="FilePrint" size="large"  onAction="insatu"/> 
          <dropDown id="dd1"  sizeString="WWWWWWWWWW"
		getItemCount="DDItemCount" 
		getItemLabel="DDListItem" 
		onAction="DDOnAction" 
		getSelectedItemIndex="DDItemSelectedIndex"/>
        </group>
        <group id="myGroup2" label="other">		
          <button id="button2" label="Select printer" 
		onAction="ValueSelectedItem" size="large" imageMso="HappyFace"/>	
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI> 
      

      
Option Explicit

Public EnabledPrinter() As String  '通常使うプリンター名

' フラッグの定数
Public Enum PRINTER_ENUM
  PRINTER_ENUM_DEFAULT = &H1
  PRINTER_ENUM_LOCAL = &H2
  PRINTER_ENUM_REMOTE = &H10
  PRINTER_ENUM_SHARED = &H20
  PRINTER_ENUM_NETWORK = &H40
End Enum

' 利用可能なプリンタ名を列挙する関数の宣言
Public Declare Function Enumprinters Lib "winspool.drv" _ 
         Alias "EnumPrintersA" _
        (ByVal flags As PRINTER_ENUM, _
         ByVal lpName As String, _
         ByVal Level As Long, _
         pPrinterEnum As Any, _
         ByVal cdBuf As Long, _
         pcbNeeded As Long, _
         pcReturned As Long) As Long

' 指定された文字列の長さを取得する関数の宣言
Public Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" _
        (ByVal lpString As Long) As Long

' ある位置から別の位置にメモリブロックを移動する関数の宣言
Declare Sub MoveMemory Lib "KERNEL32" Alias "RtlMoveMemory" _
        (Destination As Any, Source As Any, ByVal length As Long)

' プリンタ名の識別を定義する構造体
Public Type PRINTER_INFO_1
        flags As Long
        pDescription As Long
        pName As Long
        pComment As Long
End Type


Sub GetEnabledPrinter()

    Dim lngPrnLevel As Long
    Dim bytNull As Byte
    Dim bytPrnBuffer() As Byte
    Dim lngPrnNeeded As Long
    Dim lngPrnReturned As Long
    Dim udtInfo1() As PRINTER_INFO_1
    Dim lngPrnCounter As Long
    Dim lngRtnCode As Long
    Dim lngLength As Long
    Dim lngCount As Long
    Dim Printer_Flag As Long
    Dim strPrnName As String
    
' デフォルトプリンター名
' Printer_Flag = GetDefaultPrinter(LPTSTR pszBuffer,LPDWORD pcchBuffer)


' ローカルプリンタ名
    Printer_Flag = PRINTER_ENUM_LOCAL
' レベルを設定 1 = PRINTER_INFO_1
    lngPrnLevel = 1
' バッファのサイズを取得
    lngRtnCode = Enumprinters(Printer_Flag, vbNullString, lngPrnLevel, _
                 ByVal vbNullString, 0, lngPrnNeeded, lngPrnReturned)

' バッファを確保
    Const SIZEOF_PI1 = 16
    ReDim udtInfo1(lngPrnNeeded \ SIZEOF_PI1)
    
' ローカルの利用可能なプリンタ名の取得
    lngRtnCode = Enumprinters(Printer_Flag, vbNullString, lngPrnLevel, _
                              udtInfo1(0), lngPrnNeeded, lngPrnNeeded, _
                              lngPrnReturned)
    
    If lngRtnCode = 0 Then MsgBox "Err": End
    
    lngCount = lngPrnReturned
' バッファに返された構造体を確保
    
    ReDim EnabledPrinter(lngCount)
    
    For lngPrnCounter = 0 To lngCount - 1
' 取得したプリンター名の長さの取得
        lngLength = lstrlen(udtInfo1(lngPrnCounter).pName)
' 文字列型変数の確保
        strPrnName = String(lngLength, vbNullChar)
' プリンタ名を文字列型変数にコピー
        MoveMemory ByVal strPrnName, _
                   ByVal udtInfo1(lngPrnCounter).pName, lngLength
'プリンター名を表示
'        Debug.Print strPrnName
        EnabledPrinter(lngPrnCounter + 1) = strPrnName
    Next lngPrnCounter
End Sub

Public Function GetDefaultPrinter() As String
    Dim strDPrinter As String
   strDPrinter = Application.ActivePrinter
   GetDefaultPrinter = Left(strDPrinter, InStr(strDPrinter, " on ") - 1)
End Function      
       

Option Explicit

Dim ItemCount As Long
Dim IndexOfSelectedItem As Integer
'Dim MySelectedItem As String

'-------  Dropdown Callback Code --------
Sub DDItemCount(control As IRibbonControl, ByRef returnedVal) 'ItemCount
    Call GetEnabledPrinter '使用可能なプリンター名の配列作成
    ItemCount = UBound(EnabledPrinter)  '上記配列の要素数を調べる
    returnedVal = ItemCount
End Sub

Sub DDListItem(control As IRibbonControl, index As Integer, _ 
               ByRef returnedVal) 
    '使用可能なプリンター名の配列をItemに追加
    returnedVal = EnabledPrinter(index + 1) 
End Sub

Sub DDOnAction(control As IRibbonControl, ID As String, _ 
               index As Integer) 
    'Selectのインデックス
    IndexOfSelectedItem = index + 1
' way 1
'    MySelectedItem = ListItemsRg.Cells(index + 1).Value
' way 2
'    Call DDListItem(control, index, MySelectedItem)
End Sub

Sub DDItemSelectedIndex(control As IRibbonControl, ByRef returnedVal)  
    '通常使うプリンター名を表示する 
    Dim i As Integer
'   returnedVal = 0 '初期に表示するItem
    For i = LBound(EnabledPrinter()) To UBound(EnabledPrinter())
        'FUNCTION GetDefaultPrinterで調べる
        If EnabledPrinter(i + 1) = GetDefaultPrinter Then  
            GoTo EndLine
        End If
    Next i
EndLine:
    returnedVal = i
    IndexOfSelectedItem = i + 1
End Sub
'------- End Callback Code --------

Sub ValueSelectedItem(control As IRibbonControl) 
    'SelectItemのラベルとインデックス
    MsgBox "Item=" & EnabledPrinter(IndexOfSelectedItem) & _
           "  " & "Idex=" & IndexOfSelectedItem
'    MsgBox MySelectedItem & vbNewLine
End Sub


Private Sub insatu(control As IRibbonControl)
  ActiveSheet.PrintOut COPIES:=1, _ 
  ActivePrinter:=EnabledPrinter(IndexOfSelectedItem)
End Sub
      

© 2014-2015 shin2.