[[20230127172325]] 『投稿用にEXCELシートレイアウトをテキスト化の利浴x(Beck) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『投稿用にEXCELシートレイアウトをテキスト化の利用で逆は?』(Beck)

投稿用にEXCELシートレイアウトをテキスト化したのを
逆にEXCEL(EXCELシート)に読み込ませる事はVBAを利用して可能ですか ?

例えば以下のような構成をセルに忠実に書き出すなど

過去に同じ事例があるなら教えて欲しい。

     |[A]     |[B]           |[C]         |[D]               |[E]     |[F]|[G]     |[H]           |[I]       |[J]               |[K]     
 [5] |証書番号|卒業年月日    |氏   名  |生年月日          |備  考|   |証書番号|卒業年月日    |氏   名|生年月日          |備  考
 [6] |第1号   |令和5年3月31日|塩谷 小夏  |平成22年12月29日生|        |   |第11号  |令和5年3月31日|黒沢 璃乃|平成22年4月28日生 |        
 [7] |第2号   |令和5年3月31日|森下 依子  |平成22年5月23日生 |        |   |第12号  |令和5年3月31日|竹村 結花|平成22年8月28日生 |        
 [8] |第3号   |令和5年3月31日|南 真琴    |平成22年10月23日生|        |   |第13号  |令和5年3月31日|川田 和裕|平成22年6月16日生 |        
 [9] |第4号   |令和5年3月31日|織田 敏哉  |平成22年5月4日生  |        |   |第14号  |令和5年3月31日|神谷 泰佑|平成22年8月10日生 |        
 [10]|第5号   |令和5年3月31日|長谷部 志帆|平成22年5月6日生  |        |   |第15号  |令和5年3月31日|大河原 樹|平成22年4月17日生 |        
 [11]|第6号   |令和5年3月31日|金野 光子  |平成22年8月12日生 |        |   |第16号  |令和5年3月31日|田代 道雄|平成22年8月27日生 |        
 [12]|第7号   |令和5年3月31日|杉原 武秀  |平成22年10月31日生|        |   |第17号  |令和5年3月31日|風間 有香|平成22年8月2日生  |        
 [13]|第8号   |令和5年3月31日|田口 信次  |平成22年4月3日生  |        |   |第18号  |令和5年3月31日|大谷 文  |平成23年3月31日生 |        
 [14]|第9号   |令和5年3月31日|宮地 雫    |平成22年11月5日生 |        |   |第19号  |令和5年3月31日|松村 香音|平成22年9月13日生 |        
 [15]|第10号  |令和5年3月31日|松木 珠希  |平成23年1月14日生 |        |   |第20号  |令和5年3月31日|南田 拓歩|平成22年6月10日生 |        
 [16]|第21号  |令和5年3月31日|難波 愛奈  |平成22年6月23日生 |        |   |第31号  |令和5年3月31日|杉浦 早苗|平成22年9月13日生 |        
 [17]|第22号  |令和5年3月31日|本山 遥花  |平成22年11月19日生|        |   |第32号  |令和5年3月31日|金丸 圭子|平成22年6月10日生 |        
 [18]|第23号  |令和5年3月31日|市原 孝義  |平成22年12月14日生|        |   |第33号  |令和5年3月31日|栗山 基一|平成22年11月19日生|        
 [19]|第24号  |令和5年3月31日|丸田 弓斗  |平成23年3月12日生 |        |   |第34号  |令和5年3月31日|川田 正三|平成22年12月14日生|        
 [20]|第25号  |令和5年3月31日|小峰 梨々那|平成23年2月15日生 |        |   |第35号  |令和5年3月31日|熊田 裕一|平成22年11月20日生|        
 [21]|第26号  |令和5年3月31日|大内 峻輝  |平成22年8月24日生 |        |   |第36号  |令和5年3月31日|蛭田 朱音|平成22年12月15日生|        
 [22]|第27号  |令和5年3月31日|勝田 孝吉  |平成22年6月18日生 |        |   |第37号  |令和5年3月31日|重田 志歩|平成22年11月21日生|        
 [23]|第28号  |令和5年3月31日|西岡 真希  |平成23年1月9日生  |        |   |第38号  |令和5年3月31日|三枝 直人|平成22年12月16日生|        
 [24]|第29号  |令和5年3月31日|澤田 紫雲  |平成22年6月19日生 |        |   |第39号  |令和5年3月31日|橘 賢次  |平成22年11月22日生|        
 [25]|第30号  |令和5年3月31日|川嶋 風香  |平成23年1月10日生 |        |   |第40号  |令和5年3月31日|山本 信彦|平成22年12月17日生|        

< 使用 Excel:Excel2021、使用 OS:Windows11 >


[[20230126164916]]
ニックネーム変更しての投稿ですか。

(ko) 2023/01/27(金) 17:32:51


ラフに考えて

Split(文字列,"|")

こんなのを活用する感じになるんじゃないかなと
(お邪魔します) 2023/01/27(金) 17:43:42


VBAを使わないなら、当該部分をシートにコピーしてから
Alt+a+eで区切り位置ウィザードを起動して「|」で分割して
最後にいらない部分を削除して整える

(お邪魔します) 2023/01/27(金) 17:48:35


アドバイス、ありがとう。

やってみます。

[[20230126164916]]
>ニックネーム変更しての投稿ですか。

投稿者とは、違います。
直近のシートレイアウトのテキスト化を利用させてもらっただけです。

(Beck) 2023/01/27(金) 18:25:04


 サクラエディタの正規表現で整形してますが、ちょうどいい機会なのでVBAで置き換えてみました
    Sub クリップボードのパイプラインをタブに置き換え()
        Dim reg As Object
        Dim buf As String
        Dim pt As Variant
        Set reg = CreateObject("VBScript.REGExp")
        buf = GetClip
        reg.Global = True
        For Each pt In Array( _
                             Array("^\s\s.+\r\n", ""), _
                             Array(" .+?\] ?\|", ""), _
                             Array("\|", vbTab), _
                             Array(" +\t", vbTab))
            reg.Pattern = pt(0)
            If reg.test(buf) Then
                buf = reg.Replace(buf, pt(1))
            End If
        Next pt
        SetClip buf
    End Sub
    'Array("^\s\s.+\r\n", "") 列番号を行毎削除
    'Array(" .+?\] ?\|", "")  行番号を削除
    'Array("\|", vbTab)       パイプラインをタブに置き換え
    'Array(" +\t", vbTab))     半角スペースからタブをタブ単体に置き換え
    Function GetClip() As String
        'テキスト以外だとエラー
        GetClip = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")
    End Function
    Function SetClip(ByVal strClip As String)
        CreateObject("WScript.Shell").Exec("clip").stdIn.WriteLine strClip
    End Function
(稲葉) 2023/01/27(金) 18:41:38

 私は手で「データ」の「区切り位置」で分割しています。
 参考にさせていただきます。

 以下、余談です。別の話ですが、関連するかもしれない話です。

 私は皆さまのコードを拝見する際、
 投稿から単純にコピーペイストすると空行がすべて削除されてしまうので、
 何とかならないかなと感じることがあります。段落がなくなってしまうわけです。
 皆さんどうされていますか?
  
(γ) 2023/01/27(金) 19:13:55

稲葉さん、コードをいただいたので試してみました。

クリップボードにターゲットをコピーして
マクロを起動すると下記箇所でエラーが出ました。

CreateObject("WScript.Shell").Exec("clip").stdIn.WriteLine strClip

VBAのエラー
アクセスが拒否されました。

OS側の通知(エラー)
Windowsセキュリティ
操作がブロックされました。
管理者設定により、このアクションはWindowsセキュリティでブロックされました。

(Beck) 2023/01/27(金) 19:16:24


 あーその部分はクリップボードに書き戻しているだけなので、
 bufをそのままエクセルに書き込めばいいだけなんだけど・・・
 めんどくさければ、SetClipの部分はこっちに置き換えてみてください。
 私の環境だと、うまくいったりいかなかったりで不安定なんですが、純粋にVBAの機能なはずなので、たぶん行けるかと
    Function setclip(ByVal strClip As String)
        'https://www.odin.hyork.net/write/write0323.html
        '    CreateObject("MSFORMS.DataObject") ↓は左の意味
        With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
            .SetText strClip
            .PutInClipboard
        End With
    End Function

 γさん
 >投稿から単純にコピーペイストすると空行がすべて削除されてしまうので、
 今気づきました!!
 エディタに貼っても編集記号さえつかないので、完全にないですね・・・
 ソース見ると<pre>コード</pre><p></P><pre>コード</pre>なので、pタグ入ってるから空行あってもよさそうなんですけど・・・
 単純に</pre><p></P><pre>を\r\nに置き換えるしかないですかねぇ・・・

(稲葉) 2023/01/27(金) 20:39:26


稲葉さん、ありがとう。
Function setclipのコードを変更しました。

事前に「Microsoft VBScript Regular Expressions 5.5」を導入して
クリップボードに例題を入れて
マクロを実行(F8でステップ実行)

For Eachの部分でクリップボード内の内容を順番に読み込んで
ローカルウインドウの変数が変化していくので何となく順調なのは理解できます。

:::: 参考画像 :::::


::::::::::::::::::::::::::::::::::::

Net pt が終了した最後に至っても私の環境が原因なのか、
シートには何も出力されませんでした。
(今度は、エラーは最終までエラーは出なかった)

このマクロは出力部を持たないコードで
出力部を別途作成しないと駄目な仕様なのでしょうか ?

(Beck) 2023/01/28(土) 05:22:05


 クリップボードに、入れ直してるだけですよ 
 画面見る限り、stopで処理止めているので、stopの位置に SetClip buf入れてあげないと
 クリップボードに出力されないです

(稲葉) 2023/01/28(土) 06:33:05


>クリップボードに出力されないです

主力手順が分かったので
自分なりにコードを修正しました。

一応出力されますが、不具合あればご指導ください。

Option Explicit

Sub クリップボードのパイプラインをタブに置き換え()
Dim reg As Object
Dim buf As String
Dim pt As Variant

'事前に「Microsoft VBScript Regular Expressions 5.5」を導入の事。
Set reg = CreateObject("VBScript.REGExp")

Dim YN As VbMsgBoxResult
YN = MsgBox("クリップボードにEXCELシートレイアウトをテキスト化して物を読み込んでますか?", vbYesNo + vbQuestion)

If YN <> vbYes Then

        MsgBox "処理を中止します", vbCritical
End If

buf = GetClip 'Function GetClip()

reg.Global = True

'Array("^\s\s.+\r\n", "") 列番号を行毎削除
'Array(" .+?\] ?\|", "") 行番号を削除
'Array("\|", vbTab) パイプラインをタブに置き換え
'Array(" +\t", vbTab)) 半角スペースからタブをタブ単体に置き換え

For Each pt In Array( _

    Array("^\s\s.+\r\n", ""), _
    Array(" .+?\] ?\|", ""), _
    Array("\|", vbTab), _
    Array(" +\t", vbTab))
    reg.Pattern = pt(0)
    If reg.test(buf) Then
        buf = reg.Replace(buf, pt(1))
    End If
Next pt

setclip buf 'Function setclip(ByVal strClip As String)

'クリップボードに整形後を出力
setclip buf

Dim rng As Range
Set rng = Application.InputBox(Prompt:="貼り付け先のセルをクリックして選択してください。", Type:=8)

ActiveSheet.Paste Destination:=rng

MsgBox ("クリップボードに整形して出力されています。" & vbCrLf & _

       "EXCELシートの希望するセルに貼り付けました。")

End Sub
Function GetClip() As String
'テキスト以外だとエラー
GetClip = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")
End Function
Function setclip(ByVal strClip As String)
'https://www.odin.hyork.net/write/write0323.html
' CreateObject("MSFORMS.DataObject") ↓は左の意味
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText strClip
.PutInClipboard
End With
End Function

(Beck) 2023/01/28(土) 07:51:39


すいません。
ミス書き込みの訂正です。

主力手順が分かったので >>>> 出力手順が分かったので
(Beck) 2023/01/28(土) 07:53:30


お好きなようにすればいいと思うんだけど、
いちいちセルを選択させるくらいならctrl+cでもいいんじゃないかなーとか思わなくも無かったり、、、
シートに書き出すならregexp使わずに、splitで一行ごとに切り出して
変換かけてまで一連の流れを作ってから、自分なり を出して欲しかったかなぁ

(稲葉) 2023/01/28(土) 08:33:14


>自分なり を出して欲しかったかなぁ

初心者なので能力不足でオリジナリティ(自分なり)が出せないのはご勘弁ください。

>ctrl+cでもいいんじゃないかなーとか思わなくも無かったり、、、

ハウツー的にセル選択のほうが後で使い方がわからなく事も防げるかと....

稲葉さん、
一つのツールとして利用させていただきます。
教えて頂きありがとうございます。
(Beck) 2023/01/28(土) 08:44:55


欲が出て一つ追加したいのですが可能ならコードを教えてください。

例題のシートレイアウトなら「A5セル」が一番左側だと判ります。

     |[A]     |[B]           |[C]         |[D]               |
 [5] |証書番号|卒業年月日    |氏   名  |生年月日          

なのでコピペで貼り付け先のセルをクリックして選択するのでは無く
「A5」と言う情報でA5に貼り付けをするようにしたい。

(Beck) 2023/01/28(土) 09:53:34


 そこは自分でやってください
 毎回様式が変わるのに、書き出す位置を読み取って出力することに意義を感じません
 急ぎの案件でもないですし、自身の力量アップの良い例題じゃないですか?
(稲葉) 2023/01/28(土) 11:23:01

判りました。

自分でがんばってみます。

(Beck) 2023/01/28(土) 11:36:00


 私が使っている方法をご参考までに紹介しておきます。
「区切り位置」分割をマクロ化しただけのものです。

 個人用ブック(PERSONAL.XLSB)の標準モジュールに下記のプロシージャを作成します。

 Sub WEBから貼り付けて列分割()
    On Error Resume Next
    ActiveSheet.PasteSpecial Format:="Unicode テキスト", Link:=False, _
        DisplayAsIcon:=False, NoHTMLFormatting:=True
    Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:= _
        "|"
    Selection.EntireColumn.AutoFit
 End Sub

 このマクロにショートカットキー(Ctrl+M)を割り当ててます。
 掲示板からコピーして出力したいセルを選択してCtrl+Mで表として出力されます。
 列名、行番号は手作業で削除してください。
(hatena) 2023/01/28(土) 14:18:55

 >一応出力されますが、不具合あればご指導ください。
 気づいたこと。
 (1)
 If YN <> vbYes Then
         MsgBox "処理を中止します", vbCritical
 End If
 Exit Subを入れたほうがよくないですか?
 (というか、意思確認なんて要りますか?必要だからやるわけでしょ?)

 (2)
 setclip buf 'Function setclip(ByVal strClip As String)
 'クリップボードに整形後を出力
 setclip buf

 二回繰り返す必要はありません。

 (3)
 インデントが出鱈目に改悪されています。インデントは見やすさの第一条件です。

 なお、貼り付け先の自動判別は オーバースペックの気がします。
 目で見えていることだから。

 加えていうと、それなら列番号とか、行番号は消さないほうがいいでしょう。
 消そうと思えばいつでも手で消せるわけですし。
 途中の列を省略してなんてのもありますし。

 と考えてくると、区切り文字"|"による「区切り位置」のマクロを作って、
 それをクイックアクセスツールバーにでも登録して置くくらいでも機能すると思います。
 シートの適当な位置に貼り付けてから、そのマクロを実行するだけです。

 ==========================
 ということで一段落したようなので、私が横入りした件
    コード部分をコピーすると、空白行が消える件
 についての続きのコメントです。
 (稲葉さんコメントありがとうございました。)

 (1)
 ちなみに私は、こんな風にしています。
 ・「ページのソース」を表示(chromeであれば ctrl+u)
 ・関連する箇所をテキストエディターに貼り付け
 ・エディターのマクロでHTMLタグを消去
 ・VBEにコピーペイスト
 ・ツール(Smart Indenterというフリーのツール)で 自動インデント処理を施す
 という感じです。(特にインデント修正は有難いですね。そうしないと読む気になりませんので)

 エディターのマクロを見ましたら、
 ・最初に"<p>\n</p>\n" を "\n" に置換し
 ・その後、
     </?pre>\n を ""
     "^<br>\n" を "" 
     "<br>"    を ""
     "</?p>"   を "" 
     あと、quot;や lt; などの置換
  をしていました。

  (2)
  これを書いていて思い出しましたが、ワークシートを使うこんな手もありました。

  ソースのうち該当するコード部分をエディターにコピーし、
  前後に<html>と</html>を付けたうえで、(←ここがキモですかね)
  ワークシートに貼り付けると、HTMLとして解釈されて、
  改行等も見たままものが表示されます。
  それをVBEに転記すればよい、ということになります。
  これだったらエディターの正規表現マクロを使う必要もないですね。
  なにかの参考になれば幸いです。

  # hatenaさんと投稿が衝突しましたが、そのままupします。
  
(γ) 2023/01/28(土) 14:38:04

hatenaさんとγさんからアドバイスを受けました。
ありがとうございます。

hatenaさんのコード、大変便利に使えそうな方法ですね。

γさんのアドバイスでコードを見直して修正しました。

インデントが不揃いで見にくくなりすいません。
(Smart Indenterの紹介、便利そうなので後で見てみます。)

オーバースペックとの件ですが、
自動貼り付けも何とか自前でで出来ましたが
確かに実用的では無いのですが
勉強を兼ねて考えてみたので実際は使わないことになりそうです。

(Beck) 2023/01/28(土) 18:38:47


>そうしないと読む気になりませんので
だったらインデントしていないものは回答するな。
(mangan) 2023/01/28(土) 20:36:37

必要かどうか判りませんが、その後を報告します。

Smart Indenter に興味が有ったので以下を参考に導入しようとしましたが
http://tradememo.techblog.jp/archives/73543570.html
https://th1252.exblog.jp/29168720/

ダメでした。
(アドインマネージャーにSmart Indenterが表示されない)

他に同じような機能のソフト(アドイン)は無いかと探したら
64ビットバージョンをサポートしている「RubberDuck」を見つけました。
https://rubberduckvba.com/
https://qiita.com/mima_ita/items/3629006163d0a7fa6e55

これで私は美しくインデントできました。
(Beck) 2023/01/29(日) 05:19:48


 Rubberduckですか、私も以前インストールしてみたことがあります。
 (私には使う機会があまりないような)機能がたくさんありますが、
 大変重くなって使いにくくなったので、使用を断念しました。
 smart indenterのほうが断然軽いです(単機能なので。しかし、私にはこれで十分)。
[[20200801193605]] も参照ください。同様の話がでてきます。

 Rubberduckを継続使用されるのであれば、それはそれで結構なんですが、
 smart indenterに関して誤解する人が出てくるといけないので、
 念のため補足します。

 (1)
 64bit,32bitというのは、OSではなく、
 MsOffice(Excelを含む)が64bit,32bitかという意味です。
 それは以下のように確認できます。
 ・ファイル - アカウント - 「Excelのバージョン情報」のボタンをクリック。
   すると、バージョンやビルドのあとに32ビットか64ビットかが表示されます。

 (2)
 Ms Officeが64bitの場合は、使えないかもしれません。(私はそういう環境ではないので不明です)
 Ms Officeが32bitであれば、
 まず、
http://www.oaltd.co.uk/Indenter/Default.htm
 からsmart indenterをダウンロードして下さい。

 OSがWindows10以降の場合は、以下の方法で、msaddndr.dllが使える状態にする必要があると思います。
https://th1252.exblog.jp/29168720/

 上記の記事と重複しますが、ポイントだけメモします。
 (2-a)
 C:\Program Files (x86)\Common Files\DESIGNER に 「msaddndr.dll」が必要になると思います。
 記載されている方法でそれを取得し、そのフォルダに置く必要があると思います。
 (2-b)
 そして、レジストリ登録処理が必要です。これも漏らすと動作しません。
 >cd 'C:\Program Files (x86)\Common Files\DESIGNER\'
 >regsvr32 msaddndr.dll
 以上です。
  
(γ) 2023/01/29(日) 09:26:16

>これで私は美しくインデントできました。
何でそんなもん使うのですか。
コード書きながらインデントしていけば済むことなのに。
(インデント面倒くさい) 2023/01/29(日) 10:00:35

γさん、情報ありがとうございます。

>Ms Officeが64bitの場合は、使えないかもしれません。(私はそういう環境ではないので不明です)

私のExcelがまさにOffice2021Pro 64bit版なので使えないのかも?

(2),(2-a),(2-b)は問題なく実行済みですが
アドインマネージャーにSmart Indenterが表示されません。
(ちなみに、Rubberduck は、アドインマネージャーに表示が出ています。)

Rubberduck は、起動時に重くなりまだ使い始めて1日なので
もう少し試用して継続使用の是非を判断します。

又インデントに特化したアドイン他にもあるかもしれないので探してみます。
(Beck) 2023/01/29(日) 11:10:18


昔からいちいち半角スペースを打ち込んでますけど。
なんかtabキーより使いやすいので。
自由な調整できるし。

(うんこ) 2023/01/29(日) 13:54:25


 Office64bitでしたか。それではその関連情報を。

 https://newtonexcelbach.com/2015/01/27/smart-indenter-and-excel-2013/
 の
 Jacky says:
 February 4, 2017 at 11:41 pm
 の発言にあるように、64bitのOfficeの場合は、
 (1)
 C:\Windows\SysWOW64\MSADDNDR.dll のような位置にMSADDNDR.dllを置き、
 (2)
 %Systemroot%\SysWoW64\regsvr32  C:\Windows\SysWOW64\MSADDNDR.dll
 と管理者権限でレジストリ登録する必要があるようです。(まあ理屈から言ったらそうかと)
 (ただし、その記事で言うDLLが両者共用でよいのか不明です。)

 私には試す環境がなく保証できませんが、追加情報としておきます。
  
(γ) 2023/01/29(日) 15:21:17

追加情報、ありがとうございます、

最後にもう一度試してみました。

(1) C:\Windows\SysWOW64\ にMSADDNDR.dllを置き、

(2)powershellを管理者権限で以下を実施
cd 'C:\Windows\SysWOW64\'
regsvr32 msaddndr.dll

成功の表示が出たのを確認

(3)IndenterVBA.exeをインストール

Excelを起動 > VBA に移動
アドインマネージャーを見るもSmart Indenterは表示されませんでした。

手順は、間違っていないと思いますがやはり上手く行きません。
X64の環境では、駄目なようです。

(Beck) 2023/01/29(日) 17:36:16


 検証ありがとうございました。そうですかあ。残念ですね。
 それではここで一区切りとしましょうか。
  
(γ) 2023/01/29(日) 17:43:41

 インデント入ってないと確かに読みにくいですよねー
 コピーの行間あきらめて、ソフト入れられないので、簡易インデント機能作ってました。
 クラスモジュールで作ってますが、標準でもフォームでもType使えるところなら動くと思います。
 ・マルチステートメント非対応
 ・Caseは字下げあり、
 ・同名のステートメントから始まる場合は(次の例だとTypeの中のNext等)は考慮なし
 書き足し、書き直しがあるのでコードの統一性ないかも・・・
 自分用で使うので、インデントのみの単機能です。

    Option Explicit
    '//オブジェクト名:cls_indentation
    '//インデントレベル構造体
    Private Type IdtLv
        Line As Long   '処理している行のインデント
        Next As Long   '次の行のインデント
        Conn As Long   'コード内改行「 _」の文字位置 仮の処置として、「 _」の文字数分インデント
        TmpC As Long   'コード内改行の文字数一時保管
        Prev As String '直前のブロック
    End Type

    '//メインプロシジャ
    Public Function uf_CodeIndenter(CODE As String, Optional IdtCnt As Long = 4) As String
        Dim Idt As IdtLv
        Dim CashCode As String
        Dim ReadLine As Variant
        Dim v As String

        Idt.Line = 0
        Idt.Next = 0
        Idt.Conn = 0
        Idt.TmpC = 0
        Idt.Prev = ""

        '1行ずつ切り出して成形する
        For Each ReadLine In Split(CODE, vbCrLf)
            v = Trim$(ReadLine)
            Call uf_CalcIdtLv(Idt, v)
            CashCode = CashCode & String(Idt.Line * IdtCnt + Idt.Conn, " ") & v & vbCrLf
            If Idt.TmpC = 0 Then
                Idt.Line = Idt.Next
            End If
        Next ReadLine

        '書き戻し
        uf_CodeIndenter = CashCode
    End Function

    '//インデントの計算用
    Private Sub uf_CalcIdtLv(ByRef Idt As IdtLv, ByVal strLine As String)
        Dim IsSkip As Boolean
        Dim s() As String
        Dim myChr As Variant

        '[例外処理 すべてTrueなら処理を継続]
        IsSkip = True
        Select Case False
            Case Len(strLine) > 0
            Case Left(strLine, 1) <> "'"
            Case Else
                IsSkip = False
        End Select
        If IsSkip = True Then GoTo skip

        '[Private,Publicのスコープを除去する]
        For Each myChr In Array("Private", "Public")
            strLine = Replace(strLine, myChr, "")
        Next myChr
        strLine = Trim$(strLine)

        '[先頭から空白までの文字を取得]
        s = Split(strLine, " ")

        '[インデントレベルを計算する]
        Select Case s(0)

        '//インデントレベル上げる
            Case "Sub", "Function", "Property", "Type", "Enum"
            '[インデントレベル0]
                Idt.Line = 0
                Idt.Next = 1

            Case "Do", "Select", "For", "With", "Open"
            '[次の行からインデント下げるもの]
                Idt.Next = Idt.Line + 1

            Case "Case", "Case:"
            '[Caseを字下げするかは好みか]
                If Idt.Prev = "Case" Or Idt.Prev = "Case:" Then
                    Idt.Line = Idt.Next - 1
                ElseIf Idt.Prev = "Select" Then
                    Idt.Next = Idt.Line + 1
                Else
                    Idt.Line = Idt.Line - 1
                End If

            Case "If"
            '[1行書き判断]
                If Right(strLine, 4) = "Then" Then
                    Idt.Next = Idt.Line + 1
                End If

        '//インデントレベル下げる
            Case "ElseIf", "Else"
            '[インデントレベル -1(最低0)、次のコード字下げ]
                Idt.Line = Idt.Line - 1
                Idt.Next = Idt.Line + 1
                If Idt.Line < 0 Then
                    Idt.Line = 0
                End If

            Case "End", "Loop", "Next"
            '[インデントレベル -1(最低0)]
                If s(1) = "Select" Then
                    Idt.Line = Idt.Line - 2
                Else
                    Idt.Line = Idt.Line - 1
                End If
                If Idt.Line < 0 Then
                    Idt.Line = 0
                End If
                Idt.Next = Idt.Line
        End Select

        '[コード内改行をアンダーバーの位置に併せる]
        Select Case True
            Case Right$(strLine, 2) = " _"
                Select Case Idt.TmpC
                    Case 0
                        Idt.TmpC = InStrB(StrConv(strLine, vbFromUnicode), StrConv(" _", vbFromUnicode))
                        '半角全角が混ざった文字数の数え方について
                        'https://qiita.com/cyrt/items/1f23dfbac5f4c8ed80f1

                    Case Is > 0
                        Idt.Conn = Idt.TmpC

                End Select
            Case Else
                Idt.Conn = Idt.TmpC
                Idt.TmpC = 0
        End Select
        Idt.Prev = s(0)
skip:
    '[文字がない場合、コメントから始まる場合スキップ]
    End Sub

 ■使用例
    Sub ★クリップボードのコードをインデント()
        Dim buf As String
        Dim myCls As cls_indentation
        buf = GetClip
        Set myCls = New cls_indentation
        buf = myCls.uf_CodeIndenter(buf)
        setclip buf
    End Sub
    Function GetClip() As String
        'テキスト以外だとエラー
        GetClip = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")
    End Function
    Function setclip(ByVal strClip As String)
        'https://www.odin.hyork.net/write/write0323.html
        '    CreateObject("MSFORMS.DataObject") ↓は左の意味
        With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
            .SetText strClip
            .PutInClipboard
        End With
    End Function

(稲葉) 2023/01/30(月) 17:59:48


 稲葉さん、力作の提供ありがとうございました。
 皆さんの回答活動の有益な道具となると思います。
 お疲れ様でした。
  
(γ) 2023/01/30(月) 21:52:13

Indentつながりで情報だけ上げておきます。

中華のアプリですが、インストール時GUIが英語表示を選べます。

win11_x64 Office2021_x64 で作動を確認しました。

Smart Indenter for VBE v2.76 plus free download update 2018.7.30
Smart Indenter for VBE v1.80 Lite free download update 2017.9.9

https://www.cnblogs.com/charltsing/p/smartindenter64.html

(Beck) 2023/01/31(火) 16:08:42


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.