| 種別 | データベース |
|---|---|
| ご要望 | バインダー内の文書を、指定した色の付箋のみの文書ファイルにまとめたい |
| ファイル | XbdFusen.zip をクリックし、ダウンロード後に、解凍してください。 |
| 実行 イメージ |
 |
| ソース | Dim sXbd,no,sData,sDir,cnt,i,sXdw,s,col,a[],pno,pmax,p,cf,sSave,max if FileExists(バインダー名) = 0 then MsgBox(バインダー名 & "ファイルは、存在しません。") Exit Sub endif sDir = FileInfo(バインダー名, 2) & "temp\" 'フォルダパスのみ取得 DeleteFolder(sDir) CreateFolder(sDir) if FolderExists(sDir) = 0 then MsgBox(sDir & "フォルダ、存在しません。") Exit Sub endif cnt = Split(付箋の色, "、", a) '色の取得＝付箋の色の後半 col = a[1] sXbd = バインダー名 sSave = FileInfo(sXbd,4) & "_" & a[0] & ".XBD" '保存ファイル名 cnt = XdwBinder(sXbd, 6) '文書数の取得 For i=1 to cnt s = XdwBinder(sXbd,4,,i) '文書名を取得 sXdw = sDir & "\" & s XdwBinder(sXbd,2,sXdw,i) '文書取出 Next i FileDelete(sSave) XdwBinder(sSave,0,,0,5) '保存用バインダーを作成する '作業フォルダにある、全てのXDWファイルを確認する cnt = FileDir(sDir & "*.xdw") For i=1 to cnt sXdw = FileDir() 'ファイルパスの取得 pmax = XdwProperty(0,1,sXdw) '指定ファイルの総ページ数 for pno = 1 to pmax max = XdwAnnProperty(5, 0,,sXdw,pno) for p=0 to max-1 cf = XdwAnnProperty(p,7,,sXdw)'塗りつぶし色 if cf = col then '同一色の付箋あり XdwBinder(sSave,1,sXdw)'一番最後にXDWを挿入 pno = max + 1 'ページのループを強制的に抜ける exit for endif next p next pno Next i DeleteFolder(sDir)'作業用フォルダを消す MsgBox(sSave & "を、保存しました。") |
| 備考 | ver10以降、利用可能。 |