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

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

View File

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

View File

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