マークダウンファイル生成スクリプト修正

This commit is contained in:
2026-04-08 15:39:56 +09:00
parent 3854cdf6d7
commit 52f6ea2c52
4 changed files with 29 additions and 15 deletions

Binary file not shown.

View File

@@ -7,7 +7,7 @@ Sub ExportCustomizeFunctionsToMarkdownFile()
Set ws = Worksheets("カスタマイズ機能") Set ws = Worksheets("カスタマイズ機能")
Dim lastRow As Long Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).row
Dim md As String Dim md As String
Dim funcCounter As Long Dim funcCounter As Long
@@ -39,7 +39,7 @@ Sub ExportCustomizeFunctionsToMarkdownFile()
Exit Sub Exit Sub
End If End If
startRow = headerCell.Row + 1 startRow = headerCell.row + 1
For r = startRow To lastRow For r = startRow To lastRow
' ここに既存の処理 ' ここに既存の処理
@@ -124,7 +124,7 @@ Sub ExportCustomizeFunctionsToMarkdownFile()
' 先頭のスペース/矢印をカウント ' 先頭のスペース/矢印をカウント
For pos = 1 To Len(lineText) For pos = 1 To Len(lineText)
ch = Mid(lineText, pos, 1) ch = Mid(lineText, pos, 1)
If ch = " " Or ch = " " Or ch = "→" Then If ch = " " Or ch = " " Or ch = "→" Or ch = "・" Then
indentLevel = indentLevel + 1 indentLevel = indentLevel + 1
Else Else
Exit For Exit For
@@ -176,15 +176,20 @@ Sub ExportCustomizeFunctionsToMarkdownFile()
'======================== '========================
' Markdownファイル出力 ' Markdownファイル出力
'======================== '========================
Dim fso As Object, file As Object Dim stream As Object
Set fso = CreateObject("Scripting.FileSystemObject") Set stream = CreateObject("ADODB.Stream")
Dim path As String Dim path As String
path = ThisWorkbook.path & "\CustomizeFunctions.md" path = ThisWorkbook.path & "\CustomizeFunctions.md"
Set file = fso.CreateTextFile(path, True, True) ' UTF-8 With stream
file.Write md .Type = 2 ' adTypeText
file.Close .Charset = "UTF-8" ' ★ UTF-8指定
.Open
.WriteText md
.SaveToFile path, 2 ' adSaveCreateOverWrite
.Close
End With
MsgBox "Markdownファイルを出力しました" & vbCrLf & path, vbInformation MsgBox "Markdownファイルを出力しました" & vbCrLf & path, vbInformation
@@ -192,3 +197,4 @@ End Sub

View File

@@ -20,7 +20,7 @@ Sub ExcelFileImport()
'======================== '========================
Set fd = Application.FileDialog(msoFileDialogFilePicker) Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd With fd
.Title = "Excelファイルを選択してください" .title = "Excelファイルを選択してください"
.Filters.Clear .Filters.Clear
.Filters.Add "Excelファイル", "*.xlsx; *.xlsm; *.xls" .Filters.Add "Excelファイル", "*.xlsx; *.xlsm; *.xls"
.AllowMultiSelect = False .AllowMultiSelect = False

View File

@@ -1,4 +1,7 @@
Sub ExportMarkdown_Complete() Attribute VB_Name = "Module3"
Sub ExportMarkdown_Complete()
Application.ScreenUpdating = False
'============================== '==============================
' 0. 基本情報(変換定義側) ' 0. 基本情報(変換定義側)
@@ -13,7 +16,7 @@
sheetNames = Split(defWs.Range("C4").Value, vbLf) ' 対象シート(改行区切り) sheetNames = Split(defWs.Range("C4").Value, vbLf) ' 対象シート(改行区切り)
Dim startRow As Long Dim startRow As Long
startRow = defWs.Range("B5").Value ' 探索開始行 startRow = defWs.Range("C5").Value ' 探索開始行
Dim title As String Dim title As String
title = defWs.Range("N3").Value ' Markdownタイトル title = defWs.Range("N3").Value ' Markdownタイトル
@@ -66,7 +69,7 @@
r = startRow r = startRow
' 最初の定義列が空になるまで ' 最初の定義列が空になるまで
Do While dataWs.Cells(r, Columns(items.Items()(0)(0)).Column).Value <> "" Do While dataWs.Cells(r, Columns(items.items()(0)(0)).Column).Value <> ""
Dim md As String Dim md As String
md = template ' ★ テンプレートを複製 md = template ' ★ テンプレートを複製
@@ -87,6 +90,8 @@
Dim cellValue As String Dim cellValue As String
cellValue = dataWs.Cells(r, colNum).Value cellValue = dataWs.Cells(r, colNum).Value
cellValue = Replace(cellValue, vbCrLf, vbLf)
cellValue = Replace(cellValue, Chr(13), vbLf)
Select Case cond Select Case cond
@@ -160,7 +165,7 @@
' 6. Markdown ファイル生成 ' 6. Markdown ファイル生成
'============================== '==============================
Dim outPath As String Dim outPath As String
outPath = ThisWorkbook.Path & "\output.md" outPath = ThisWorkbook.path & "\output.md"
Dim stream As Object Dim stream As Object
Set stream = CreateObject("ADODB.Stream") Set stream = CreateObject("ADODB.Stream")
@@ -172,4 +177,7 @@
MsgBox "Markdownファイルを生成しました" & vbCrLf & outPath, vbInformation MsgBox "Markdownファイルを生成しました" & vbCrLf & outPath, vbInformation
Application.ScreenUpdating = True
End Sub End Sub