システムwiki

単語Docxから自分のファイルへの詩を抽出するための単語マクロ

Michael 解決済 最終更新日:2021-06-15 02:18

こんにちは、

私が単語のマクロを書いたので久しぶりです、そして私が書いたものはとても簡単でした.あなたは私にさびたと呼ぶことができます.

私はタイトルのない短い5回の詩、タイトルなしの短い3つの線の詩、タイトルを持ついくつかの散文+詩、そして5つの5つの詩のいくつかのシーケンスを含む、いくつかの異なる品種の約110ページの詩があります.タイトルとスペースを使って
5行の詩ごとに.すべての詩はスペースで終わり、その後、私のPseudon onemherhryとそれに続く(c)シンボルと年、または最近年の年/月

私はマクロを詩の各タイプを見つけるために、それを単語Docxからそれ自身の単語DOCXにコピーしたいと思います、詩がタイトルを持っているならタイトルまたは詩の最初の行がありません..

時々、2つ以上の詩は同じタイトルまたは1行目を持ち、ファイル名の最後に2を追加するだけで十分です.

私はすでにこれらの詩のためのファイルフォルダを設定しました.

上記の詩的な形式の1つに収まらない詩は、ファイルに入ります.彼らはほとんどないでしょう、そして私は手動でそれらをすることができます.

私はあらゆる助けに感謝します...正しい方向、準備ができたソリューション、ズボンのキックでさえ押します.

安全で最高の願いを留める、

マイケル

返信リスト(回答:7)

7 #
GrahamM

あなたの文書が説明されているとおり

の場合、次のように機能する必要があります.

オプション
サブSplitPoems()
グラハム市長- リンク:M.-最終更新日-2020年3月23日
ドキュメントとしてDIM ODOC
ドキュメントとして薄暗く薄暗くなる 薄型範囲
段落として薄暗いOpara
ムラ

const strpathとしてstring= "c:\path\poems \" "書類を保存するフォルダ
string= "mhenry©" 'としてconst strfindこれは、詩の終わりにあなたの文書内にあるものと一致する必要があります(日付を無視してください). ODOC= ActiveDocumentを設定する
odoc.ave

enert on on goto lbl_exit
WordBasic.DisableAutomacros 1
set orng= odoc.range
INSTR(1、odoc.range.text、strfind)= 0の場合、LBL_EXITが
orng.end= instr(1、odoc.range.text、strfind)
orng.end= orng.paragraphs.last.range.end
onewdoc= documents.add(odoc.fullname)を設定します OneWDoc.Range.FormattedText= orng.formattedText
Len(orng.paragraphs(1).Range)= 1
orng.paragraphs(1).range.delete
WEND
strname= cstr(左(orng.paragraphs(1).Range、Len(orng.paragraphs(1)."-1)&".docx "
strname= cleanfilename(strname、 "docx")
strname= filenameUnique(strpath、strname、 "docx")
onewdoc.saveas2 strpath&strname
onewdoc.close
orng.cut
行動
WordBasic.DisableAutomacros 0
ループ
ODOC.CLOSE 0
lbl_exit:
set odoc= nother
onewdoc=何も設定します set orng=何もない




Private Function CleanFileName(StringとしてのstrfileName、StryStensionとしてStrestension)文字列としての
'グラハム市長
'不正なファイル名がないことを保証する機能
ファイル名として使用される文字列内の文字
'strfileNameは
をチェックするためのファイル名です 'strextensionはファイルの拡張機能です Dim ArrinValid()は文字列として
VFNAME AS VARIATT AS
DIM LNG_NAMEの長い
DIM LNG_EXTの長い
薄暗い
'エクステンションに含まれている期間が含まれていないことを確認します. strExtension=置換(Strextension、Chr(46)、 "")
'拡張子の長さを記録する
lng_ext= len(strextension)
'存在する場合はファイル名からパスを削除する
INSTR(1、STRFILENAME、CHR(92))>0から
vfname= split(strfilename、chr(92))
CleanFileName= vfname(ubound(vfname))


cleanfilename= strfilename

の場合は終了 '存在する場合はファイル名から拡張子を削除する
右(CleanFileName、LNG_EXT + 1)= ""の場合&strextensionそれから
cleanFileName= left(CleanFileName、Instrrev(CleanFileName、Chr(46))-1)

の場合は終了 '違法な文字を定義する(ASCII Charnumによって)
ArrInValid=分割( "9|10|11|47|58|62|63|62|124"、 "|")
'拡張子をファイル名に追加する
CleanFileName= CleanFileName&Chr(46)&StrExtension
'不正なファイル名文字を削除する
lngindex= 0からubound(arrinvalid)
CleanFileName=置換(CleanFileName、Chr(arrinvalid(LNGINDEX))、Chr(95))
次のLNGINDEX
lbl_exit:
終了機能
終了機能
プライベート関数filenameUnique(Strpathとしてのstrpath、_
strfilenameとして文字列、_
ストリングとしてstrextension

'グラハム市長
'fileexists関数の使用を必要とする
'strpathは、ファイルを保存するパスです. 'strfileNameは
をチェックするためのファイル名です 'strExtensionはチェックするためのファイル名の拡張機能です. when longnameの長い
strExtension=置換(Strextension、Chr(46)、 "")
LNGF= 1
lngname= len(strfilename)-(Len(StrExtension)+ 1)
strfilename= left(strfilename、lngname)
'filenameが存在する場合は、filenameに番号を追加または増分します. 'そしてユニークな名前が見つかるまでチェックを続ける
FileExists(STRPATH&STRFILENAME&CHR(46)&STRExtension)= true
strfilename= left(strfilename、lngname)&"("&lngf&")"
LNGF= LNGF + 1
ループ
'filenameを再組み立てする
filenameunique= strfilename&chr(46)&strextension
lbl_exit:
終了機能
終了機能
プライベート関数fireeExists(文字列としてのstrupllname)ブール
'グラハム市長
'strubllnameは、
vsoをオブジェクトとして
insfsoをチェックするファイルのパスを持つ名前です
FSO= CreateObjectを設定します( "scripting.filesystemObject")
fso.fileexists(strupllname)なら
fileexists= true


FileExists= false

の場合は終了 lbl_exit:
fso= nother
終了機能
終了関数

応答7# ->にスキップ
6 #
Michael

うわー!私はこれを試してみることに興奮しています!グラハムに感謝します!私は今仕事中ですので、後で試してみてください.

安全に滞在!

願い、

マイケル

昨夜試してみるには遅すぎた...私は家から働いていて、それは実際にそのように一日の仕事を終えるために時間がかかります.

できるだけ早く結果を返します.

応答6# ->にスキップ
5 #
Michael

こんにちは、グラハム、

今日、仕事で遅い日だったので、マクロを試すことができました.6ページの詩をテストのために新しいファイルにコピーし、シームレスに機能します.どうもありがとうございました!

Tweakまたは2つを求めるのが多すぎるのだろうか、それは私の元の要求は指定されたか、または予想しなかったのを省略したかどうかを忘れません.

私のパスに次の新しいフォルダを追加しました.d:\myworks\writings2\

Tanka 2(5回の詩のために-短歌)

俳句2(3段階の詩-俳句)

Tanka Prose 2(Prose and Tankaを含む詩のための)

タンカシーケンス2(短歌の5枚の詩シーケンス用)

詩2(他のすべての形式の場合)

尋ねるには多すぎるカテゴリーの下に...

1)各タイプの詩を自分のフォルダに送ってください(これは大きな助けになるでしょう、そして私はこれを尋ねることを意味します)

2)詩から前述のまたは末尾のスペースを取り除く(私はそれが本当に尋ねるには単純なマクロでこれを修正することができます)

3)元のファイルに元の詩を残してください(再び、元のファイルを閉じるときは変更を保存しないでください.しかし、何かがHaywireになる場合
私自身の誤っているため、それを持っているのはいいでしょう).

繰り返します、ありがとうございました.これは私に多くの時間を節約し、私は感謝しています.

願い、

マイケル

応答5# ->にスキップ
4 #
GrahamM

1.実際には、特にあなたが詩をどのようにフォーマットしたかを知らずに、これが簡単なことです.改行または段落の区切りを使用します.決定するために、各タイプの文書の「行」に正確な数を指定する必要があります.
それを保存する場所.

2.これがどういう意味なのかわからないが、OneWDOCが保存される前に呼び出された場合は、各段落

からの先頭と末尾の空白を消去します.

SUB CLEARWHITESPACE(OTARGET ASドキュメントとして)
薄型範囲
const strfind1としてstring= "^ 13 [!^ 13] [^ 9 ^ 32] {1、} *([^ 33-^ 126]) "
const strrepl1としてstring= "^ p\1"
const strfind2としてstring= "[^ 9 ^ 32] {1、} ^ 13 "
const strrepl2としてstring= "^ p"
set orng= otarget.range
orng.collapse 1
orng.moveendwhile chr(32)&chr(9)
orng.text= "" "" "" orng.end= otarget.range.end
orng.find
.text= strfind1
.replaction.text= strepl1
.matchwildcards= true
.execute置換:= wdreplaceAll


orng.find
.text= strfind2
.replaction.text= strepl2
.matchwildcards= true
.execute置換:= wdreplaceAll


lbl_exit:
otarget=何もない
set orng=何もない


終了SUB

3.文書のコピーを操作することで、このような問題を回避できます.

でマクロを起動します

ActiveDocument.save
ActiveDocument.path= ""の場合
ビープ音



の場合は終了 ODOC= ActiveDocumentを設定する
'ドキュメントを一時ファイルとして保存し、原稿を上書きされているのを保護します. odoc.saveas2 filename:= environ( "temp")&chr(92)&activeDocument.name、fileFormat:= 12

応答4# ->にスキップ
3 #
Michael

ありがとう、Graham!

2と3はとても些細なので、私は彼らにあなたを悩ませてはいけません.

1は、段落の破損を使用するだけで、ほとんどOCDの原因で、行ずなしの行がありません.

ここでは、#1でショットを取る傾向があると感じる場合がある場合に備えて、ファイルからのスニップがあります.

それは4つのタイプの詩の4つのタイプの4つのタイプを含んでいます、5番目はかなり稀です.

Tanka Proseは、1つの文と1人のタンカから数段落と複数のタンカまでの範囲です.

Tanka、Haiku、およびTankaシーケンスは、常に同じ数の短いケースを除いて、常に同じ数の線(5,3,25、+空間)です.

他に何もないならば、私はあなたがあなたが詩を楽しむことを願っています!

必要な介入

ラウンジョン

セメントのブロック

heck

のどこにある驚異

すべての人々が

に行きました

黒い猫

黄色の眼の葉で

待つ

にあります

ミルクボウルはまだ

です

それは餌としてのクラムを残します

windows

彼女のほうき

に彼女の手

hedgewitch

ストレスの多いシーンを調査する

ピジョンはその運命を満たしますか?

windows

栗の木を過ぎる

hedgewitch

ブドウ園

を囲みます

低軌跡

そのような

のように

彼女は猫

を驚かせる

誰がその背中をアーチします

突然の狂信の恐怖

そしてハトは飛行にかかります

Mhenry©2020/03/24

ポジティブ-

コネチーテーションは

になりました

耐え難い

Mhenry©2020/03/24

を賞賛します

彼がAX

を振る方法

滑らかなストローク

相対的な静脈瘤

彼が私の頭から切り裂くように

Mhenry©2020/03/24

夜明けから夕暮れ

青少年は彼のブム

を調整します

フェンス

すべてのペニー

を数える

彼は彼の友達から盗まれています

Mhenry©2020/03/24

Tomcat

を維持することを主張します

この熱

私は彼がCaterwauling

の声を聞くことができます

通りの途中から

Mhenry©2020/03/24

結婚式はキャンセルされました

新しいコロナウイルス-

のために

スリップノット

Mhenry©2020/03/24

これらの危険な時間

自宅での大まかな夜...彼のルームメートで彼らの息子の問題を働いて整理しようとしている-彼女は金曜日に刑務所から出たときに彼女のボーイフレンドが一晩一晩滞在することを望んでいます.彼らの息子は彼を好きではなく、されていた見知らぬ人が欲しくない
コロナウイルスは彼のアパートにあるために入った.彼の母親は彼らの息子のルームメートの母親との懸念を議論します.彼女は自宅での滞在に従っていない、そしてリスクの高い人々のためにほとんど共感を示していません.
またはその問題のための他の誰か.この状況が保留になった直後、母と息子は彼の過度の支出習慣の上にSPATに入り、2時間の貴重な時間を消費します.

潜んだ

悪意のある力

米国の中で-

夕食には遅すぎる

彼は飢えている

を寝かせる

Mhenry©2020/03/24

DoorkNobs

を消毒する

消毒剤の拭き取り-

無限ループ

Mhenry©2020/03/25

この片頭痛

私の脳の中でドキドキ

絶え間ない

を文句を言わせるための使用はありません

痛みが増加する場合は

Mhenry©2020/03/25

に入るには

EagleHawks

の世界

あなたの目を閉じます

あなたが成長した翼

を想像してみてください

風にあなたの運命を信頼する

Mhenry©2020/03/25

出現

松林

から

ヤングバック

ホークソール

を見てください

苔覆われた湖

Mhenry©2020/03/25

どうやって

を望みます

私は鷹のように飛ぶことができました-

または降圧

のように

松林に住んでいる

苔覆われた湖

Mhenry©2020/03/25

応答3# ->にスキップ
2 #
GrahamM 2

以下はあなたの例で動作します:

オプション
サブSplitPoems()
グラハム市長- リンク:M.-最終更新日-2020年3月26日
ドキュメントとしてDIM ODOC
ドキュメントとして薄暗く薄暗くなる 薄型範囲
段落として薄暗いOpara
ムラ

Dim StrnewPathは文字列として
String= "d:\myworks\writings2 \" '文書を保存するルートフォルダとしてconst strpath
string= "mhenry©" 'としてconst strfindこれは、詩の終わりにあなたの文書内にあるものと一致する必要があります(日付を無視してください). ActiveDocument.save
ActiveDocument.path= ""の場合
ビープ音



の場合は終了 'ドキュメントを一時ファイルとして保存し、原稿を上書きされているのを保護します. ActiveDocument.SaveAS2ファイル名:=環境( "temp")&chr(92)&"Temporary Copy"&ActiveDocument.name、fileFormat:= 12
ODOC= ActiveDocumentを設定する

enert on on goto lbl_exit
WordBasic.DisableAutomacros 1
set orng= odoc.range
INSTR(1、odoc.range.text、strfind)= 0の場合、LBL_EXITが
orng.end= instr(1、odoc.range.text、strfind)
orng.end= orng.paragraphs.last.range.end
onewdoc= documents.addを設定する(テンプレート:= odoc.fullname)
OneWDoc.Range.FormattedText= orng.formattedText
onewdoc.range.find
.text= chr(160)
.replaction.text= "" "" "" .execute置換:= wdreplaceAll


len(onewdoc.range.paragraphs(1).Range)= 1
onewdoc.range.paragraphs(1).Range.Delete
WEND
strname= cstr(左(onewdoc.range.paragraphs(1).range、len(onewdoc.range.paragraphs(1)-1)&".docx"
strname= cleanfilename(strname、 "docx")
strname= filenameUnique(strpath&getFolder(OneWDoc)、strname、 "docx")
ClearWhiteSpace OnewDoc.Range
strnewpath= strpath&getFolder(OneWdoc)
CreateFolders StrnewPath
onewdoc.saveas2 filename:= strnewpath&strname、fileFormat:= 12、addtorecentfiles:= false
'debug.print onewdoc.range.paragraphs.count&vbtab&onewdoc.fullname
onewdoc.close
orng.cut
行動
WordBasic.DisableAutomacros 0
ループ
lbl_exit:
set odoc= nother
onewdoc=何も設定します set orng=何もない




Private Function CleanFileName(StringとしてのstrfileName、StryStensionとしてStrestension)文字列としての
'グラハム市長
'不正なファイル名がないことを保証する機能
ファイル名として使用される文字列内の文字
'strfileNameは
をチェックするためのファイル名です 'strextensionはファイルの拡張機能です Dim ArrinValid()は文字列として
VFNAME AS VARIATT AS
DIM LNG_NAMEの長い
DIM LNG_EXTの長い
薄暗い
'エクステンションに含まれている期間が含まれていないことを確認します. strExtension=置換(Strextension、Chr(46)、 "")
'拡張子の長さを記録する
lng_ext= len(strextension)
'存在する場合はファイル名からパスを削除する
INSTR(1、STRFILENAME、CHR(92))>0から
vfname= split(strfilename、chr(92))
CleanFileName= vfname(ubound(vfname))


cleanfilename= strfilename

の場合は終了 '存在する場合はファイル名から拡張子を削除する
右(CleanFileName、LNG_EXT + 1)= ""の場合&strextensionそれから
cleanFileName= left(CleanFileName、Instrrev(CleanFileName、Chr(46))-1)

の場合は終了 '違法な文字を定義する(ASCII Charnumによって)
ArrInValid=分割( "9|10|11|47|58|62|63|62|124"、 "|")
'拡張子をファイル名に追加する
CleanFileName= CleanFileName&Chr(46)&StrExtension
'不正なファイル名文字を削除する
lngindex= 0からubound(arrinvalid)
CleanFileName=置換(CleanFileName、Chr(arrinvalid(LNGINDEX))、Chr(95))
次のLNGINDEX
lbl_exit:
終了機能
終了機能
プライベート関数filenameUnique(Strpathとしてのstrpath、_
strfilenameとして文字列、_
ストリングとしてstrextension

'グラハム市長
'fileexists関数の使用を必要とする
'strpathは、ファイルを保存するパスです. 'strfileNameは
をチェックするためのファイル名です 'strExtensionはチェックするためのファイル名の拡張機能です.長い
DIM LNGNAMEの長い

strExtension=置換(Strextension、Chr(46)、 "")
LNGF= 1
lngname= len(strfilename)-(Len(StrExtension)+ 1)
strfilename= left(strfilename、lngname)
'filenameが存在する場合は、filenameに番号を追加または増分します. 'そしてユニークな名前が見つかるまでチェックを続ける
FileExists(STRPATH&STRFILENAME&CHR(46)&STRExtension)= true
strfilename= left(strfilename、lngname)&"("&lngf&")"
LNGF= LNGF + 1
ループ
'filenameを再組み立てする
filenameunique= strfilename&chr(46)&strextension
lbl_exit:
終了機能
終了機能
プライベート関数fireeExists(文字列としてのstrupllname)ブール
'グラハム市長
'strubllNameは、チェックするファイルのパスを持つ名前です. オブジェクトとしてのDIM FSO
FSO= CreateObjectを設定します( "scripting.filesystemObject")
fso.fileexists(strupllname)なら
fileexists= true


FileExists= false

の場合は終了 lbl_exit:
fso= nother
終了機能
終了機能
プライベートサブクリアウォンスペース(範囲としてのOTarget)
const strfind1としてstring= "^ 13 [!^ 13] [^ 9 ^ 32] {1、} *([^ 33-^ 126]) "
const strrepl1としてstring= "^ p\1"
const strfind2としてstring= "[^ 9 ^ 32] {1、} ^ 13 "
const strrepl2としてstring= "^ p"
Otarget.Collapse 1
Otarget.MoveendWhile chr(32)&chr(9)
otarget.text= "" "" "" otarget.end= otarget.end
Otarget.find
.text= strfind1
.replaction.text= strepl1
.matchwildcards= true
.execute置換:= wdreplaceAll


Otarget.find
.text= strfind2
.replaction.text= strepl2
.matchwildcards= true
.execute置換:= wdreplaceAll


lbl_exit:
otarget=何もない




文字列

としてのプライベート関数getFolder(OtargetDoc)

グラハム市長- リンク:M.-最終更新日-2020年3月26日

'Tanka 2(5回の詩-短歌)
'俳句2(3段階の詩-俳句)
'短歌散文2(散文と短歌を含む詩のため)
'Tanka Sequence 2(短歌の5枚の詩シーケンス用)
'詩2(他のすべての形のために)
整数として薄暗い箱
icount= otargetdoc.range.paragraphs.count
ケースicountを選択する
ケースは= 6
getFolder= "\haiku 2 \"
ケースは= 8
getFolder= "\Tanka 2" "
ケースは= 12
getFolder= "\Tanka Prose 2" "
ケースは= 34
getFolder= "\Tanka Sequence 2 \"
ケース
getFolder= "詩2 \"
終了
lbl_exit:
終了機能
終了機能
パブリックサブCreateFolders(Strpathとしてのstrpath)
'a Graham Mayor/Greg Maxey Addin Utilityマクロ
オブジェクトとしてのDIMのDim
[課題]長い
右(strpath、1)<>"\"<>"\" strpath= strpath&"\"
LNG_PATHSEP= INSTR(3、STRPATH、 "\")
lng_pathsep= 0の場合、lbl_exit
so= createObject( "scripting.filesystemObject")の設定

lng_ps= lng_pathsep
LNG_PATHSEP= INSTR(LNG_PS + 1、STRPATH、「\」)
lng_pathsep= 0の場合、exit do
lenの場合(dir(左(strpath、lng_pathsep)、vbdirectory))= 0次に終了します. ループ
lng_pathsep= 0

になるまでする そうでない場合は、(左(strpath、lng_pathsep))
OFSO.CreateFolder左(Strpath、LNG_PATHSEP)

の場合は終了 lng_ps= lng_pathsep
LNG_PATHSEP= INSTR(LNG_PS + 1、STRPATH、「\」)
ループ
lbl_exit:
so= Nothing


終了SUB

応答2# ->にスキップ
1 #
Michael

こんにちは、グラハム、

それは美のものです!魔法のように動作します.

どうもありがとうございました!

安全で願いを留めてください!