前提・実現したいこと
例えば1つのExcelのブック(以下、元ファイル)の、1シートごとにテーブル項目定義が
設定されていて、
その情報を元にCreate Table のSQL文を、テンプレートのブック(以下、SQLブック)の
既存シートのシートに貼り付けたい/書き出して、別名で保存したい。
・テンプレートとなるSQLブックのシート名は、元ファイルのシート名と同様にしたい。
・元ファイル1ブックの1シートから、SQL文を書き出したいSQLブックは1ブック。
つまり、2つの元ファイルに其々5つのシートがあれば、2つのSQLブックに其々5つのシートができる。
・SQL文は、SQLブックの【B30】のセルから、1行に1項目ずつ書きたい
例)
Create Table test( ← 【B30】 (タブ)社員番号 VARCHAR(19) ← 【B31】 (タブ),名前 VARCHAR(19) ← 【B3②】 : : ); ← 【B50とか】
発生している問題
①書き出したいテンプレートのブックを、まずOpenすると2つ同じものが開く
②元ブックから、SQLブックへ転記ができない、シート名も変えられない
③別名で保存ができない
<<<どのように記述すると、シート名が変更できたり、セルに値が書き込めて
それを保存することができるのでしょうか。>>>
該当のソースコード
Sub SQL定義書作成() Dim dstSheet As Worksheet Set dstSheet = ThisWorkbook.Worksheets(1) '入力のExcelファイル(テーブル項目説明 )へのパス Dim Path As String Path = dstSheet.Range("B23").Value & "\" Dim buf As String buf = Dir(Path & "*.xls") Dim srcBook As Workbook Dim sqlBook As Workbook 'SQL文の出力先テンプレートファイル 'SQL文の出力先(SQL定義書)のテンプレートファイルへのパス Workbooks.Open dstSheet.Range("B26").Value & "\" & "tenplate_SQL定義.xls" '出力先ファイル(全テーブル分の詳細設計書:SQL定義書)へのパス Dim Detailed_design_doc As String Detailed_design_doc = dstSheet.Range("B29").Value ' Application.ScreenUpdating = False Dim i As Long Do While buf <> "" i = i + 1 'テーブル項目説明書 Set srcBook = Workbooks.Open(Path + buf) Call sakuseisql_detail(sqlBook, srcBook) ' sqlBook.Close False ' srcBook.Close False buf = Dir() Loop MsgBox "処理が完了しました", Title:="SQL定義書 作成" End Sub Function sakuseisql_detail(ByVal sqlB As Workbook, ByVal srcB As Workbook) ' On Error GoTo errorend Dim irow As Integer Dim i As Integer Dim strPK As String Dim strName As String Dim strtype As String Dim strketa As String Dim strNN As String Dim srcSheet As Worksheet Dim sqlSheet As Worksheet Set srcSheet = srcB.Worksheets(2) ← 【一番目のシートは、変更履歴だから、”2”】 Set sqlSheet = sqlB.Worksheets(1) 'テーブルのカラム数(項目名称の個数:2列目)取得 irow = srcSheet.Cells(Rows.Count, 2).End(xlUp).Row '【SQL定義書のシート名設定】 sqlSheet.Select sqlSheet.Name = Trim(srcSheet.Name) ← 【設定(変更)されない!!!】 '【SQL定義書に書込む内容】← 【書き込まれない】 Range("G4").Select ActiveCell.FormulaR1C1 = sqlSheet.Name Range("G5").Select ActiveCell.FormulaR1C1 = sqlSheet.Name Range("G7:N7").Select ActiveCell.FormulaR1C1 = "作成" Range("G9").Select ActiveCell.FormulaR1C1 = "テーブル " & sqlSheet.Name & " を作成するためのCreateTable文" '【SQL定義書に書込むSQL文】← 【書き込まれない!!!】 Range("B30").Select ActiveCell.FormulaR1C1 = "CREATE TABLE " & sqlSheet.Name & " (" '【SQL定義書に書込む内容】 Range("B31").Select ← 【書き込まれない!!!】 For i = 6 To irow strPK = "" strNN = "" strName = Trim(srcSheet.Cells(i, 2).Value) '項目名 strtype = Trim(srcSheet.Cells(i, 3).Value) 'データ型 strketa = Trim(srcSheet.Cells(i, 4).Value) 'データ長 strPK = Trim(srcSheet.Cells(i, 5).Value) 'PrimaryKey strNN = Trim(srcSheet.Cells(i, 6).Value) 'NULL If i = 6 Then ActiveCell.FormulaR1C1 = ActiveCell.FormulaR1C1 & vbTab & " " Else ActiveCell.FormulaR1C1 = ActiveCell.FormulaR1C1 & vbTab & "," End If '項目名と型とサイズ' ActiveCell.FormulaR1C1 = strName & " " & strtype & "(" & strketa & ")" 'PKの有無チェック If strPK <> "" Then ActiveCell.FormulaR1C1 = ActiveCell.FormulaR1C1 & " PRIMARY KEY" End If 'NOT NULL制約有無のチェック If (strNN = "×") Then If strPK = "" Then ActiveCell.FormulaR1C1 = ActiveCell.FormulaR1C1 & " PRIMARY KEY" & " NOT NULL" End If End If If i = irow Then ActiveCell.FormulaR1C1 = ActiveCell.FormulaR1C1 & vbCrLf & ");" Else ActiveCell.FormulaR1C1 = ActiveCell.FormulaR1C1 & vbCrLf End If Next i sqlB.SaveAs Filename:=Detailed_design_doc & "\5X_JKY_J090_SQL定義_" & sqlSheet.Name & ".xls" 'errorend: End Function
回答2件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2018/10/19 02:21
2018/10/19 02:36
2018/10/19 03:22 編集
2018/10/19 04:15
2018/10/19 09:58
2018/10/19 10:09
2018/10/19 10:11