暗号化・復号化(4)

【´･ω･`】:さてExcel版の「暗号化・復号化」ではかずさんが

　　　　　遊んでくれたので、こんどはWordで「暗号化・復号化」を

　　　　　やってみよう。

　　　　　　ほんとうのことを言えばおいらはWord VBAはあんまり

　　　　よく知らないので自信がないのだが生まれついてのお調子者だから

　　　　仕方がない。

　　　　仕様：大雑把ではあるが、テキストの暗号化。ただしオートシェイプだの

　　　　コメントだの、図表の中のテキストは無視。

　　　　さて、遊んでくれる人はいるかいな？

Comments

[投稿情報: y sakuda]

別にWordでやってもやることは同じでは？
パラグラフ単位に取り出して、改行コードを無視するようにして、以下同文・・・

[投稿情報: くまぷー]

>別にWordでやってもやることは同じでは？

同じではなかった・・・
Excelでは書式情報がセルに残っているがワードでは・・・

ちなみにおいらのコード（その１）・・・

Sub 暗号化X()
Dim i As Integer
Dim j As Integer
Dim Mojisu As Long
Dim DanrakuNum As Long
Dim MyFont As String
Dim Moji As String
Dim CodeNum As Long
Dim Bun As String




Set R = Selection.Range
MyFont = R.Font.Name
DanrakuNum = R.Paragraphs.Count

Mojisu = R.Characters.Count

str = R.Text

Bun = ""
For i = 1 To Mojisu
Moji = Mid(str, i, 1)
CodeNum = AscW(Moji)
Moji = ChrW(CodeNum * -1)

Bun = Bun + Moji
Next
Selection.TypeText Bun
End Sub

[投稿情報: くまぷー]

上のコードでは書式情報が失われてしまうんです(T.T)

文字サイズも、文字の色も、
センタリングなどの文字位置も・・・

Excelだったら、セルに書式情報が残っているのに・・・( ｉдｉ ) ハウー

[投稿情報: くまぷー]

でもね、何とかあがいて手は見つけました・・・（￣＾￣）

[投稿情報: y sakuda]

なるほど、パラグラフフォーマットなんかが消えちゃいますね。
ただ、こんな簡単なのでは、部分書式に対応できませんね。
また、テキストボックスなんかはStoryRangeコレクションでまわせば良いのですが、アンカーが付いているパラグラフが変更されるとアンカーもろともテキストボックスが消えちゃいますねｗ

[投稿情報: くまぷー]

>テキストボックスなんかは

そんなもの凄いところまで
面倒みようとは思ってはいないのですが
wordは手強いです。

・・・で、次の「暗号化・復号化（５）」を
ご覧下さい。m(__)m

[投稿情報: y sakuda]

とりあえず、Alignment、パラグラフ全体のサイズ、色のみ対応
Sub aaa()
Dim wPara As Paragraph, wText As String, wNText As String, I As Long, J As Long
Dim wFormat As Long
With ThisDocument.Content
　For J = .Paragraphs.Count To 1 Step -1
　　Set wPara = .Paragraphs(J)
　　wText = wPara.Range.Text
　　wNText = ""
　　For I = 1 To Len(wText)
　　　wCode = AscW(Mid(wText, I, 1))
　　　If Abs(wCode) 1 Then
　　　　wFormat = wPara.Range.ParagraphFormat.Alignment
　　　　With wPara.Range
　　　　　.Text = wNText
　　　　　 .ParagraphFormat.Alignment = wFormat
　　　　End With
　　End If
　Next
End With
End Sub

フォントタイプはハングルに変わったとこで替えられちゃう^^;

[投稿情報: くまぷー]

さっそく、参加して頂きありがとうございます。

＞If Abs(wCode) 1 Then

ここのところはどうなっていますか？
エラーになってしまいます。

[投稿情報: y sakuda]

>If Abs(wCode) 1 Then
ありゃ、半角の不等号が消えちゃってますね。

If Abs(wCode)＜15 Then

です。
つまり、FFやらCR,LFは変換しないという意味です。

[投稿情報: y sakuda]

少し変えて部分書式にも対応しました。
（文字列の途中でフォントサイズや色が変わっていても保存されます）

Sub bbb()
Dim wPara As Paragraph, I As Long, J As Long, N As Long, P As Long
Dim wCode As Long
With ThisDocument.Content
For J = .Paragraphs.Count To 1 Step -1
Set wPara = .Paragraphs(J)
With wPara.Range
N = Len(.Text)
P = .Start
For I = N To 1 Step -1
wCode = AscW(Mid(.Text, I, 1))
If Abs(wCode) ＞ 14 Then
ThisDocument.Range(P + I - 1, P + I).Text = ChrW(wCode * -1)
End If
Next
End With
Next
End With
End Sub

面倒なので、インデント直すのやめました。
悪しからず。

[投稿情報: くまぷー]

＞If Abs(wCode)＜15 Then

上記の通りにして試してみましたが
「End Withに対応するWithがありません」と
怒られてしまいます。
よく見てみるとForループが２つあるのに
Nextが一つしかないようですが・・・

[投稿情報: くまぷー]

あ、上のコメントはaaaに対してのものです。
早速、bbbを試してみます。

[投稿情報: y sakuda]

もう一箇所不等号使ってましたwww
全部再掲します。失礼しました。
Sub aaa()
Dim wPara As Paragraph, wText As String, wNText As String, I As Long, J As Long
Dim wFormat As Long, wCode As Long
With ThisDocument.Content
For J = .Paragraphs.Count To 1 Step -1
Set wPara = .Paragraphs(J)
wText = wPara.Range.Text
wNText = ""
For I = 1 To Len(wText)
wCode = AscW(Mid(wText, I, 1))
If Abs(wCode) ＜ 15 Then
wNText = wNText & ChrW(wCode)
Else
wNText = wNText & ChrW(wCode * (-1))
End If
Next
If Len(wNText) ＞1 Then
wFormat = wPara.Range.ParagraphFormat.Alignment
With wPara.Range
.Text = wNText
.ParagraphFormat.Alignment = wFormat
End With
End If
Next
End With
End Sub

[投稿情報: くまぷー]

サンプルを２つも作って頂き、ありがとうございます。
早速、aaa、bbbともに実行してみました。
aaaはbbbに比べると超速ですね。

aaaがまとめて書き込むのに対して
ｂｂｂは一文字ずつ書き込んでいるのですね。でも色とサイズは保存されるのに
どうして事態は保存されないのだろう？
不思議だ(?_?)

[投稿情報: y sakuda]

>どうして事態は保存されないのだろう？
結局暗号化した代物がハングルなんで、フォント変えざる得ないんじゃないでしょうか？
それにしても、やはり、どうやってもレンジをいじるとアンカーつぶれちゃうな・・・・
なんとかしたいんですが^^;

[投稿情報: くまぷー]

＞結局暗号化した代物がハングルなんで

なるほど・・・　下の文章で実験してみました。

「なるほど、パラグラフフォーマットなんかが消えちゃいますね。

ただ、こんな簡単なのでは、部分書式に対応できませんね。
また、テキストボックスなんかはStoryRangeコレクションでまわせば良いのですが、アンカーが付いているパラグラフが変更されるとアンカーもろともテキストボックスが消えちゃいますねｗ」

bbbを実行してもハングルにならない文字が
いくつかありますが、その文字に関しては
字体がちゃんと保存されますね。

[投稿情報: くまぷー]

＞アンカーつぶれちゃうな・・・・
なんとかしたいんですが^^;

それができたらもう完璧ですね！！

[投稿情報: y sakuda]

しかしねーー
WordVBAで遊んでても誰も寄ってこないとオモフ・・・・・
MougのWordVBAの板でも回答者が少ないと言うより、質問者自体が極めて少数www

[投稿情報: くまぷー]

＞WordVBAで遊んでても誰も寄ってこないとオモフ・・・・・

(;ﾟﾟ)ｳｯ!
そ、それを言っては・・・

[投稿情報: くまぷー]

＞＞WordVBAで遊んでても誰も寄ってこないとオモフ・・・・・

でも、おいらは必要もないのに
一太郎マクロとか
三四郎マクロに
手を染めてしまった男・・・
http://kumapooh2007.hp.infoseek.co.jp/Taro_Macro_01.html
http://kumapooh.justblog.jp/blog/2007/04/post_29ec.html