DB設計書も出力できるように修正

This commit is contained in:
2026-04-21 11:32:00 +09:00
parent 52f6ea2c52
commit 97029b6fdc
3 changed files with 69 additions and 11 deletions

Binary file not shown.

Binary file not shown.

View File

@@ -18,11 +18,17 @@ Sub ExportMarkdown_Complete()
Dim startRow As Long
startRow = defWs.Range("C5").Value ' 探索開始行
Dim OutPutStyle As String
OutPutStyle = defWs.Range("C6").Value ' 出力スタイル
Dim title As String
title = defWs.Range("N3").Value ' Markdownタイトル
Dim template As String
template = defWs.Range("M4").Value ' Markdownテンプレート
template = defWs.Range("M5").Value ' Markdownテンプレート
Dim titleTemplate As String
titleTemplate = defWs.Range("M4").Value ' Markdownテンプレート
'==============================
' 1. 項目定義B/C/F列
@@ -33,7 +39,7 @@ Sub ExportMarkdown_Complete()
Set items = CreateObject("Scripting.Dictionary")
Dim defRow As Long
defRow = 6
defRow = 7
Do While defWs.Cells(defRow, 2).Value <> ""
items.Add defWs.Cells(defRow, 2).Value, _
@@ -74,9 +80,15 @@ Sub ExportMarkdown_Complete()
Dim md As String
md = template ' ★ テンプレートを複製
Dim titlemd As String
titlemd = titleTemplate ' ★ テンプレートを複製
Dim category As String
category = ""
Dim categoryFixed As String
categoryFixed = ""
Dim key As Variant
For Each key In items.Keys
@@ -85,13 +97,17 @@ Sub ExportMarkdown_Complete()
colLetter = items(key)(0)
cond = items(key)(1)
Dim colNum As Long
colNum = Columns(colLetter).Column
If cond = "種別(固定)" Then
categoryFixed = dataWs.Range(colLetter).Value
Else
Dim colNum As Long
colNum = Columns(colLetter).Column
Dim cellValue As String
cellValue = dataWs.Cells(r, colNum).Value
cellValue = Replace(cellValue, vbCrLf, vbLf)
cellValue = Replace(cellValue, Chr(13), vbLf)
Dim cellValue As String
cellValue = dataWs.Cells(r, colNum).Value
cellValue = Replace(cellValue, vbCrLf, vbLf)
cellValue = Replace(cellValue, Chr(13), vbLf)
End If
Select Case cond
@@ -108,9 +124,17 @@ Sub ExportMarkdown_Complete()
Next i
cellValue = Trim(listText)
Case "種別"
Case "種別(表)"
category = cellValue
cellValue = "" ' テンプレートには出さない
Case "種別(固定)"
If category = "" Then
category = Replace(titlemd, "{" & key & "}", categoryFixed)
Else
category = Replace(category, "{" & key & "}", categoryFixed)
End If
cellValue = "" ' テンプレートには出さない
Case Else
' なし:そのまま使用
@@ -128,7 +152,14 @@ Sub ExportMarkdown_Complete()
If categoryMap.Exists(category) Then
categoryMap(category) = categoryMap(category) & vbCrLf & md
Else
categoryMap.Add category, md
If OutPutStyle = "表" Then
categoryHeader = Replace(template, "{", "")
categoryHeader = Replace(categoryHeader, "}", "")
categoryLine = ReplaceExceptTarget(template, "|", "-")
categoryMap.Add category, categoryHeader & vbCrLf & categoryLine & vbCrLf & md
Else
categoryMap.Add category, md
End If
End If
Else
normalBlocks = normalBlocks & vbCrLf & md
@@ -138,7 +169,12 @@ Sub ExportMarkdown_Complete()
Loop
Next sn
srcWb.Close False
' 既に開いていた場合はクローズしない
If Not srcWb Is Nothing Then
If srcWb.ReadOnly Then
srcWb.Close False
End If
End If
'==============================
' 5. Markdown 全体を生成
@@ -181,3 +217,25 @@ Sub ExportMarkdown_Complete()
End Sub
Function ReplaceExceptTarget( _
ByVal src As String, _
ByVal targetChar As String, _
ByVal replaceStr As String) As String
Dim i As Long
Dim result As String
Dim ch As String
For i = 1 To Len(src)
ch = Mid(src, i, 1)
If ch = targetChar Then
result = result & ch
Else
result = result & replaceStr
End If
Next i
ReplaceExceptTarget = result
End Function