هل يمكن ربط ملف اكسل بملف اكسس

[ibrahim_elkashef]

برجاء المساعده من اخوانى الاعزاء بالمنتدى

كيف يمكن لى ان اربط ملف اكس بملف اكسس عن طريق الفيجوال بيسك
بحيث استطيع ان انقل بيانات موجوده بملف الاكسل الى جدول موجود فى ملف اكسس

وشكرا جزيلا وجعله الله فى ميزان حسناتكم جميعا ان شاء الله

[hichamchak]

Copy-stick the code below in a module of your application.
Then use it such as it is.

It was made with Access. Some very brief adaptations are to be made for qu' it turns with VB. Replace simply the Public clause of the Excel_Application variable (in l' heading) by vulgar Dim. And remove the " Compare database". C' is all.

Option Compare Database
Option Explicit


Public Excel_Application As Excel.Application

Public Sub Excel_Atteindre_cellule(Coordonnées_cellule As String)

With Excel_Application
.Range(Coordonnées_cellule).Select
End With

End Sub

Public Sub Excel_Création_Lien_OLE()

Set Excel_Application = CreateObject("Excel.Application")

End Sub

Public Sub Excel_Dans_cellule_Saisir_valeur(Coordonnées_cellu le As String, valeur As Variant)

With Excel_Application
.Range(Coordonnées_cellule).FormulaR1C1 = valeur
End With

End Sub

Public Sub Excel_Enregistrer_Classeur_courant(Optional Nom_fichier As String)

With Excel_Application
If IsNull(Nom_fichier) Then
.ActiveWorkbook.Save
Else
.ActiveWorkbook.SaveAs Nom_fichier
End If
End With

End Sub

Public Sub Excel_insérer_colonne()

With Excel_Application
.Selection.Insert Shift:=xlToRight
End With

End Sub

Public Sub Excel_insérer_ligne()

With Excel_Application
.Selection.Insert Shift:=xlDown
End With

End Sub

Public Function Excel_Lire_valeur(Coordonnées_cellule As String) As Variant

With Excel_Application
Excel_Lire_valeur = .Range(Coordonnées_cellule).FormulaR1C1
End With

End Function

Public Sub Excel_Saisir_valeur(valeur As Variant)

With Excel_Application
.ActiveCell.FormulaR1C1 = valeur
End With

End Sub

Public Sub Excel_Nouveau_classeur(Optional Modèle As String)

With Excel_Application
.Visible = True
If Modèle = "" Then
.Workbooks.Add
Else
.Workbooks.Add Modèle
End If
.WindowState = xlMaximized
End With

End Sub

Public Sub Excel_Quitter()

Excel_Application.Quit

End Sub

Public Sub Excel_Quitter_sans_sauver()

Dim Classeur As Workbook

With Excel_Application

For Each Classeur In .Workbooks
Classeur.Saved = True
Next

.Quit

End With

End Sub

Public Sub Excel_Suppression_Lien_OLE()

Set Excel_Application = Nothing

End Sub

Sub Excel_Test(Optional paramètre_requis As String)

If paramètre_requis = "" Then
Debug.Print ("Paramètres requis pour le test" & vbCrLf & vbCrLf & "La syntaxe est" & vbCrLf & "Excel_Test 1 ou" & vbCrLf & "Excel_Test 2 ou" & vbCrLf & "Excel_Test 3")
Else
Excel_Création_Lien_OLE
Select Case paramètre_requis
Case 1, 2, 3
Excel_Nouveau_classeur
Excel_Dans_cellule_Saisir_valeur "B2", "Jacques PRESTREAU"
Excel_Atteindre_cellule "C4"
Excel_Saisir_valeur "2 bis, avenue Xxxx"
Excel_Atteindre_cellule "E1"
Excel_Saisir_valeur "Développeur Access et VB"
Excel_Dans_cellule_Saisir_valeur "A3", Mid(Excel_Lire_valeur("C4"), 5, 6)
Select Case paramètre_requis
Case 1
Excel_Quitter 'Demande si on veut enregistrer les modifs
Case 2
Excel_Enregistrer_Classeur_courant "Démo d'un classeur fait par VBA.xls"
Excel_Quitter 'Fichier sauvé, donc quitte sans message
Case 3
Excel_Quitter_sans_sauver 'Quitte sans sauver les modifs
End Select
Case Else
Debug.Print "Le paramètre ne peut être que 1 ou 2 ou 3"
End Select
End If

End Sub

[BABOBA]

مشككككرررررررررررررووووووووووووررررررر