Update Z1 export to use common functions

vba_code_common.txt

@@ -110,3 +110,93 @@ Function ReadCSVFile(ByVal filePath As String) As Variant
     
     ReadCSVFile = Split(textContent, vbLf)
 End Function
+
+' ============================================================
+' Get save file path for CSV
+' Returns: file path or "" if cancelled
+' ============================================================
+Function GetSaveCSVPath(Optional ByVal defaultName As String = "") As String
+    Dim savePath As String
+    savePath = Application.GetSaveAsFilename( _
+        FileFilter:="CSV Files (*.csv), *.csv", _
+        Title:="Save CSV", _
+        InitialFileName:=defaultName)
+    
+    If savePath = "False" Or savePath = "" Then
+        GetSaveCSVPath = ""
+        Exit Function
+    End If
+    
+    If InStr(1, savePath, ".csv", vbTextCompare) = 0 Then
+        savePath = savePath & ".csv"
+    End If
+    
+    GetSaveCSVPath = savePath
+End Function
+
+' ============================================================
+' Write content to CSV file with Shift-JIS encoding
+' ============================================================
+Sub WriteCSVFile(ByVal filePath As String, ByVal content As String)
+    Dim stream As Object
+    Set stream = CreateObject("ADODB.Stream")
+    With stream
+        .Type = 2
+        .Charset = "shift_jis"
+        .Open
+        .WriteText content, 1
+        .SaveToFile filePath, 2
+        .Close
+    End With
+End Sub
+
+' ============================================================
+' Build CSV content from worksheet
+' Parameters:
+'   ws - worksheet
+'   startRow - data start row
+'   endRow - data end row
+'   dataColumns - array of column numbers to export
+' Returns: CSV content string
+' ============================================================
+Function BuildCSVContent(ByVal ws As Worksheet, ByVal startRow As Long, ByVal endRow As Long, ByRef dataColumns() As Long, Optional ByVal headerRow As Long = 0) As String
+    Dim csvContent As String
+    Dim r As Long
+    Dim col As Long
+    Dim firstCol As Boolean
+    
+    ' Build header if specified
+    If headerRow > 0 Then
+        For col = LBound(dataColumns) To UBound(dataColumns)
+            If col = LBound(dataColumns) Then
+                csvContent = Trim(ws.Cells(headerRow, dataColumns(col)).Value)
+            Else
+                csvContent = csvContent & "," & Trim(ws.Cells(headerRow, dataColumns(col)).Value)
+            End If
+        Next col
+        csvContent = csvContent & vbLf
+    End If
+    
+    ' Build data rows
+    For r = startRow To endRow
+        If Len(Trim(ws.Cells(r, dataColumns(LBound(dataColumns))).Value & "")) > 0 Then
+            firstCol = True
+            For col = LBound(dataColumns) To UBound(dataColumns)
+                If firstCol Then
+                    csvContent = csvContent & CleanCSVField(ws.Cells(r, dataColumns(col)).Value)
+                    firstCol = False
+                Else
+                    csvContent = csvContent & "," & CleanCSVField(ws.Cells(r, dataColumns(col)).Value)
+                End If
+            Next col
+            csvContent = csvContent & vbLf
+        End If
+    Next r
+    
+    ' Trim trailing newlines
+    Do While Right(csvContent, 1) = vbLf
+        csvContent = Left(csvContent, Len(csvContent) - 1)
+    Loop
+    
+    BuildCSVContent = csvContent
+End Function

vba_code_kotsu_master.txt

@@ -224,66 +224,50 @@ Sub Z1_ExportMasterDetailData()
     Dim ws As Worksheet
     Set ws = ActiveSheet
     
+    ' Get last data row
     Dim lastDataRow As Long
-    lastDataRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
+    lastDataRow = GetLastDataRow(ws, 3)
     
     If lastDataRow < 7 Then
         MsgBox "No data rows to output.", vbExclamation
         Exit Sub
     End If
     
+    ' Get save path
     Dim savePath As String
-    savePath = Application.GetSaveAsFilename( _
+    savePath = GetSaveCSVPath()
-        FileFilter:="CSV Files (*.csv), *.csv", _
+    If savePath = "" Then Exit Sub
-        Title:="Save CSV")
     
-    If savePath = "False" Then Exit Sub
+    ' Define columns to export (C, I-R = 3, 9-18)
-    If InStr(1, savePath, ".csv", vbTextCompare) = 0 Then
+    Dim dataColumns(0 To 9) As Long
-        savePath = savePath & ".csv"
+    dataColumns(0) = 3
-    End If
+    dataColumns(1) = 9
+    dataColumns(2) = 10
+    dataColumns(3) = 11
+    dataColumns(4) = 12
+    dataColumns(5) = 13
+    dataColumns(6) = 14
+    dataColumns(7) = 15
+    dataColumns(8) = 16
+    dataColumns(9) = 17
+    dataColumns(10) = 18
     
-    ' Build header from row 5 (columns C, G-P)
+    ' Build CSV content (with header from row 5)
     Dim csvContent As String
-    csvContent = Trim(ws.Cells(5, 3).Value)
+    csvContent = BuildCSVContent(ws, 7, lastDataRow, dataColumns, 5)
-    Dim j As Long
-    For j = 7 To 16
-        csvContent = csvContent & "," & Trim(ws.Cells(5, j).Value)
-    Next j
-    csvContent = csvContent & vbLf
     
-    ' Row counter
+    ' Count rows
     Dim rowCount As Long
     rowCount = 0
-    
-    ' Data: C,G,H,I,J,K,L,M,N,O,P (skip D,E,F)
     Dim r As Long
     For r = 7 To lastDataRow
         If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
             rowCount = rowCount + 1
-            ' CSV col1 -> C column
-            csvContent = csvContent & CleanCSVField(ws.Cells(r, 3).Value)
-            ' CSV col2-11 -> I-R column
-            For j = 9 To 18
-                csvContent = csvContent & "," & CleanCSVField(ws.Cells(r, j).Value)
-            Next j
-            csvContent = csvContent & vbLf
         End If
     Next r
     
-    ' Trim trailing empty lines
-    Do While Right(csvContent, 1) = vbLf
-        csvContent = Left(csvContent, Len(csvContent) - 1)
-    Loop
-    
     ' Write file
-    Dim stream As Object
+    Call WriteCSVFile(savePath, csvContent)
-    Set stream = CreateObject("ADODB.Stream")
-    stream.Type = 2
-    stream.Charset = "shift_jis"
-    stream.Open
-    stream.WriteText csvContent, 1
-    stream.SaveToFile savePath, 2
-    stream.Close
     
     MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation
 End Sub