ник: ??????
Re[1]: Связь таблиц Vba Вам в руки :)
Public Sub GetFromExcel()
On Error GoTo er
Dim cmd As ADODB.Command
Dim obj As Object
Dim st As Variant
Dim curGrp As String
Dim i As Long
Dim rst As ADODB.Recordset
Set cmd = New ADODB.Command
удалим таблицу
cmd.ActiveConnection = CurrentProject.Connection
cmd.CommandText = "DROP TABLE FromExcel"
cmd.CommandType = adCmdText
cmd.Execute
создадим её заново
cmd.CommandText = "CREATE TABLE FromExcel (NGroup nvarchar(50),Naim nvarchar(255),Price double, Kolvo int)"
cmd.Execute
Set cmd = Nothing
Set rst = New ADODB.Recordset
rst.Open "SELECT * FROM FromExcel", CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic
начнём заполнять таблицу
Set obj = GetObject("c: 1.xls") место, где лежит файл
i = 1
st = obj.ActiveSheet.Range("a" & i & ":a" & i)
curGrp = vbNullString
Do While st <> vbNullString
rst.AddNew
If st Like "Группа*" Then
If st <> curGrp Then
curGrp = st
End If
i = i + 1
st = obj.ActiveSheet.Range("a" & i & ":a" & i)
If st = vbNullString Then Exit Do
End If
rst![NGroup] = curGrp
rst![Naim] = st
rst![Price] = CDbl(obj.ActiveSheet.Range("b" & i & ":b" & i))
rst![Kolvo] = CLng(obj.ActiveSheet.Range("c" & i & ":c" & i))
rst.Update
i = i + 1
st = obj.ActiveSheet.Range("a" & i & ":a" & i)
Loop
Set obj = Nothing
rst.Close
Set rst = Nothing
Exit Sub
er:
Select Case Err.Number
Case -2147217865
Resume Next
Case Else
MsgBox Err.Number & vbCrLf & Err.Description
End Select
End Sub