Sub ImportFromAccess()
    Dim cn As Object
    Dim rs As Object
    Dim sql As String
    Dim row As Long
    
    ' 接続文字列（パスを環境に合わせて変更）
    Set cn = CreateObject("ADODB.Connection")
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=C:\Database\sample.accdb;"
    
    ' SQL文
    sql = "SELECT * FROM 売上データ"
    
    Set rs = cn.Execute(sql)
    row = 2
    
    ' フィールド名を出力
    For i = 0 To rs.Fields.Count - 1
        Cells(1, i + 1).Value = rs.Fields(i).Name
    Next i
    
    ' データを出力
    Do Until rs.EOF
        For i = 0 To rs.Fields.Count - 1
            Cells(row, i + 1).Value = rs.Fields(i).Value
        Next i
        rs.MoveNext
        row = row + 1
    Loop
    
    rs.Close
    cn.Close
End Sub

Sub ExportToAccess()
    Dim cn As Object
    Dim sql As String
    Dim name As String
    Dim amount As Long
    
    name = Range("A2").Value
    amount = Range("B2").Value
    
    Set cn = CreateObject("ADODB.Connection")
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=C:\Database\sample.accdb;"
    
    sql = "INSERT INTO 売上データ (顧客名, 金額) " & _
          "VALUES('" & name & "', " & amount & ")"
    cn.Execute sql
    
    cn.Close
    MsgBox "Accessにデータを登録しました！"
End Sub

Sub GetGoogleSheetData()
    Dim http As Object
    Dim JSON As Object
    Dim URL As String
    
    ' APIキーとシートIDを設定
    URL = "https://sheets.googleapis.com/v4/spreadsheets/{シートID}/values/Sheet1!A1:D10?key={APIキー}"
    
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", URL, False
    http.Send
    
    ' 結果を確認（JSON形式で返る）
    MsgBox http.responseText
End Sub

Sub DeleteEmptyRows()
    Dim i As Long
    For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
        If WorksheetFunction.CountA(Rows(i)) = 0 Then
            Rows(i).Delete
        End If
    Next i
End Sub

Sub MergeSheets()
    Dim ws As Worksheet
    Dim wsMaster As Worksheet
    Dim rng As Range
    Dim lastRow As Long
    Dim pasteRow As Long
    
    Set wsMaster = ThisWorkbook.Sheets("集計シート")
    pasteRow = 1
    
    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> wsMaster.Name Then
            lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
            Set rng = ws.Range("A1:A" & lastRow)
            rng.Copy wsMaster.Cells(pasteRow, 1)
            pasteRow = wsMaster.Cells(wsMaster.Rows.Count, 1).End(xlUp).Row + 1
        End If
    Next ws
End Sub

Sub SaveDailyReport()
    Dim filePath As String
    Dim todayDate As String
    
    todayDate = Format(Date, "yyyymmdd")
    filePath = "C:\Reports\Report_" & todayDate & ".xlsx"
    
    ThisWorkbook.SaveCopyAs filePath
    MsgBox "本日のレポートを保存しました: " & filePath
End Sub