[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『エクセルで一覧にしたxdwファイルを印刷』 (よーこ）
OS XP
Ver Excel2003
はじめて投稿させていただきます。
『エクセルで一覧にしたxdwファイルを印刷』（えびあん） さんからの質問と同じ内容で恐縮ですが、私も回答どおりに実行すると動くようになったのですが、プリントする際に順番が変わってしまいます。プリンター設定をいじると順番どおりにいくようですが、共有のため、その設定は行えません。
大変お手数ですが、順番どおりに出力する方法はございますでしょうか？
下記にえびあんさんの質問と回答を載せます。
====
プロフェッショナルの皆様のお知恵をお借りしたく、お世話になります。
よろしくお願いします。 エクセルで拡張子xdwファイル（ドキュワークス）をE列に一覧にしてあるのですが、 マクロか何かでE列と同じファイル名のものを指定したフォルダより 次々印刷できる方法などはないのでしょうか？ 今はハイパーリンクをして、ひとつづつ開いて手動で印刷しているのですが、 一覧の内容が30も40もあるものが複数あり、ちょっと遠い目になりつつあります…
便利な方法、ありませんか･･･？ ====
'=======================================================================
Sub main()
Dim fso As Object
Dim ff As Object
Dim ffi As Object
Dim Rng As Range
Dim myarray As Variant
Set Rng = Range("e1", Cells(Rows.Count, "e").End(xlUp))
If Rng.Count > 1 Then
myarray = get_array(Rng)
With CreateObject("Shell.Application")
Set ff = .NameSpace("C:\Documents and Settings\デスクトップ\testfold")
' ↑印刷対象のxdwファイルがあるフォルダ名を指定する
End With
Set fso = CreateObject("scripting.filesystemobject")
For Each ffi In ff.Items
If ffi.IsFileSystem And (Not ffi.IsFolder) _
And LCase(fso.GetExtensionName(ffi.Name)) = "xdw" _
And Not IsError(Application.Match(ffi.Name, myarray, 0)) Then
ffi.InvokeVerb "印刷(&P)"
End If
Next
Set ffi = Nothing
Set ff = Nothing
Set fso = Nothing
End If
End Sub
'=============================================================================
Function get_array(Rng As Range, Optional except As Long = 1) As Variant
On Error Resume Next
Dim rngA As Range
With CreateObject("scripting.dictionary")
For Each rngA In Rng
If rngA.Row <> except Then
.Item(rngA.Value) = ""
End If
Next
get_array = .Keys
End With
End Function
回答済みになっていたので勝手に修正 13:13 （てつろう）
Shellで取得したファイル順で処理してるのでセルの順番ではなくなっているのかな？ myarrayの順番にすれば良いのでしょうけど、Shellの扱いがイマイチ微妙にわからないので ヒントだけですみません。
お詫びにDocuWorksが正規にインストールされているのであれば DocuWorks Viewer Controlが使えるはずなので・・・ ユーザーフォームを配置してツールボックスを右クリックでその他コントロールを選ぶと コントロールの追加ウインドウが出るので、その中からDocuWorks Viewer Controlに チェックを入れてOKします。 ツールボックスにDwCtrlEdというコントロールが出来るので、それをフォーム上に配置します。 で、準備は完了で UserFormActivateイベントにでも
Private Sub UserForm_Activate()
Dim tbl, i As Long, flg As Boolean
Const myFolder As String = "D:\test\"
tbl = Worksheets("Sheet1").Range("E1").CurrentRegion.Value
For i = 1 To UBound(tbl)
With Me.DwCtrlEd1
flg = .LoadFile(myFolder & tbl(i, 1) & ".xdw")
If flg Then
.PrintNoDialog
.CloseFile
End If
End With
Next i
Unload Me
End Sub
こんなコードを入れてみてください。 あとはボタンか何かで
Sub ボタン1_Click() UserForm1.Show End Sub
のようにフォームを起動すれば順番に印刷できると思います。
SDKが配布されていたので、それを参考に書いてみました。 直接コントロールを操作するので、私にはこちらの方が解り易かったですが （ｍｏｍｏ）
まだ検証を行っていませんが、イメージがつかめてきました。
検証後、また改めて結果を報告いたします。
お忙しい中ありがとうございます。
質問者さんが最終報告する前ですが、時間が経っているのでこちらに書き込みます。 （ｍｏｍｏ）さんの回答で使用しようと思うのですが、 オートフィルタが設定されていると、tblに可視セル行のみをうまく取り込めなく解決方法を探しています。
CurrentRegion.Value だと非表示行までテーブルに取り込んでしまうし、 CurrentRegion.SpecialCells(xlCellTypeVisible) だと連続された行までしかtblに取り込めないのです。
あまり詳しくないのでWebで検索してみたのですが、もしかしてCurrentRegion以外でないとダメなのでしょうか？
OS XP EXCEL 2003 (わんころ)
CurrentregionプロパティはRange("A1").CurrentRegion だと、
A1セルを含む、空白セルで囲まれた矩形範囲が取得されます。
だから、取得したい範囲内に、空白行や、空白列が存在すると
途中までしか取得できません。
Autofilter.Range.SpecialCells(xlCellTypeVisible)
ですと、オートフィルタが適用されているセル範囲における可視
セルが取得できます。
ただし、これがtblに取得できるかどうかは未検証です。
(みやほりん)(-_∂)b
書き換えてみましたが、tblに取り込むのは同じく途中までとなってしまいます。 もう少し検索して勉強しつつ代案を探してみます。 コメントありがとうございました。 (わんころ)
なんか見たことあるな〜と思ったら私の回答でしたね。 忙しい＆今夜から出張なのでヒントだけしか回答できずにすみませんが・・・
Autofilter.Range.SpecialCells(xlCellTypeVisible) をAreasで回すと出来るかな？と思います。
For Each myArea in Autofilter.Range.SpecialCells(xlCellTypeVisible).Areas tbl=myArea.Value
のように。 未検証ですので出来なかったらすみません。
（ｍｏｍｏ）
For Each myArea in Autofilter.Range.SpecialCells(xlCellTypeVisible).Areas を書き加えて、tbl=〜 を置き換えるだけではダメなのですね。 myAreaの変数の宣言エラーはなんとかなりましたが、 Autofilterの変数の宣言エラーで行き詰まりました。 検索してみます。 （ｍｏｍｏ）さん、お忙しい中ありがとうございます。
（わんころ）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.