Private Sub CreateTable_Click()
If Len(Me.FilePath & "") = 0 Then
MsgBox "Please select an Excel File"
Exit Sub
End If
If TableExists("tblMatrix") Then
CurrentDb.Execute "Drop Table tblMatrix"
End If
Dim my_xl_app As Object
Dim my_xl_worksheet As Object
Dim my_xl_workbook As Object
Set my_xl_app = CreateObject("Excel.Application")
Set my_xl_workbook = my_xl_app.Workbooks.Open(Me.FilePath)
Set my_xl_worksheet = my_xl_workbook.Worksheets("Matrix")
Dim MatrixStartColumn As Long
Dim MatrixEndtColumn As Long
Dim H1Row As Long
Dim H2Row As Long
Dim strH1 As String
Dim strH2 As String
Dim strNA_AA As String
Dim strProdukt As String
Dim CellValue As Variant
Dim MatrixStartRow As Long
Dim MatrixEndRow As Long
Dim NA_AAColumn As Long
Dim ProduktColumn As Long
Dim i As Long
Dim j As Long
Dim strSQL As String
DoCmd.Hourglass True
CurrentDb.Execute "CREATE TABLE [tblMatrix] ([NA_AA] TEXT, [COLOR="Red"][Produkt-/Maßnahme-/Kombi- Bezeichnung][/COLOR] TEXT, [H1] TEXT, [H2] TEXT, [Cell] TEXT );"
MatrixStartRow = 3
MatrixEndRow = 49
NA_AAColumn = 1
ProduktColumn = 2
MatrixStartColumn = 3
MatrixEndtColumn = 48
H1Row = 1
H2Row = 2
For i = MatrixStartColumn To MatrixEndtColumn
strH1 = my_xl_worksheet.Cells(H1Row, i).Value
strH2 = my_xl_worksheet.Cells(H2Row, i).Value
' Debug.Print "Col " & i & " " & strH1
For j = MatrixStartRow To MatrixEndRow
strNA_AA = my_xl_worksheet.Cells(j, NA_AAColumn)
strProdukt = my_xl_worksheet.Cells(j, ProduktColumn)
CellValue = my_xl_worksheet.Cells(j, i)
strSQL = "INSERT INTO [tblMatrix] ([NA_AA], [COLOR="red"][Produkt-/Maßnahme-/Kombi- Bezeichnung][/COLOR], [H1], [H2], [Cell]) VALUES ('" _
& SQP(strNA_AA) & "','" & SQP(strProdukt) & "','" & SQP(strH1) & "','" & SQP(strH2) & "','" & CellValue & "');"
CurrentDb.Execute strSQL
Next j
Next i
Set my_xl_worksheet = Nothing
my_xl_workbook.Close SaveChanges:=False
Set my_xl_workbook = Nothing
Set my_xl_app = Nothing
DoCmd.SelectObject acTable, , True
DoCmd.Hourglass False
End Sub