✔ Programação GLOBAL®: VBA Access - Gerenciando os Relacionamentos - VBA code for creating MS Access Relations

DESENVOLVO APLICAÇÕES VBA

Acesse uma ENORME lista de Dashboards e Infográficos

Aprenda a detectar gráficos que precisam mudar

Dados ou Informações?

Dashboards - 8 Importantes características desejáveis

Dashboards e Infocharts - Diversas Visualizações de Dados

Diversos exemplos de Gráficos

Excel - DashMap - Mapa do Brasil

Key Performance Indicators - 7 Características desejáveis

MIS - Usufruindo a excelência na análise das suas Informações

O Melhor do Business Intelligence

Os 10 mandamentos do gerenciamento de projetos

Receba 3 Calendários Customizáveis de 2013 em Excel

Usando Gauges em Dashboards no MS Access

Você tem direito as informações da sua empresa

A funcionalidade abaixo permite automatizarmos a criação de relacionamentos entre tabelas.

Public Function CreateAllRelations()

Dim db As DAO.Database

Dim totalRelations As Integer



Set db = CurrentDb()

  Let totalRelations = db.Relations.Count

If totalRelations > 0 Then

For i = totalRelations - 1 To 0 Step -1

db.Relations.Delete (db.Relations(i).Name)

Next i

Debug.Print Trim(Str(totalRelations)) + " Relacionamentos deletados!"

End If



Debug.Print "Criando Relacionamentos..."



''Exemple

'Relacionando Employee Master com Employee CheckIn

Debug.Print CreateRelation("Employee", "Code", _

"CheckIn", "Code")

' Relacionando Orders com Order Details

Debug.Print CreateRelation("Orders", "No", _

"OrderDetails", "No")



totalRelations = db.Relations.Count

Set db = Nothing

Debug.Print Trim(Str(totalRelations)) + " Relacionamentos criados!"

Debug.Print "Completado!"

End Function

Private Function CreateRelation(primaryTableName As String, _

primaryFieldName As String, _

foreignTableName As String, _

foreignFieldName As String) As Boolean

On Error GoTo ErrHandler

Dim db As DAO.Database

Dim newRelation As DAO.Relation

Dim relatingField As DAO.Field

Dim relationUniqueName As String



Let relationUniqueName = primaryTableName + "_" + primaryFieldName + _

"__" + foreignTableName + "_" + foreignFieldName



Set db = CurrentDb()

'Argumentos para CreateRelation(): Qualquer nome único,

' Tabela primária, tabela relacionada, atributos.

Set newRelation = db.CreateRelation(relationUniqueName, _

primaryTableName, foreignTableName)

' O campo da tabela primária.

Set relatingField = newRelation.CreateField(primaryFieldName)



Let relatingField.ForeignName = foreignFieldName



newRelation.Fields.Append relatingField



db.Relations.Append newRelation

Set db = Nothing

Let CreateRelation = True

Exit Function

ErrHandler:

Debug.Print Err.Description + " (" + relationUniqueName + ")"

CreateRelation = False

End Function