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