Aide Formulaire VBA pour fichier en partage
Bonjour
Je m'y connait peu côté programmation. J'ai tenté de trouver comment partager un fichier excel avec un USF pour lequel jaimerais que plusieurs personnes puissent l'utiliser en même temps, mais sans succès.
Les données du Usf sont transférées vers un onglet BDD. Cest la le hic car les données entrent en conflit les donnees qui s'écrivent dans cet onglet.
Jai vu que pt un fichier BDD et un pour le usf permettraient de regler ce conflit mais aucune idée comment procéder.
Ci joint le fichier avec le usf et au besoin le fichier BDD.
Les document se trouvent dans le chemin suivant
W:\SACC\Accès_restreint\Logistique_Que\Plaintes & interventions
J'ai du ajouter mes fichiers en zip car était trop volumineux sinon
Merci pour vos éclaircissements
Bonjour,
Même Microsoft n’encourage pas cette méthode,
en particulier : Fonctionnalités non prises en charge
nous vous recommandons la co-création, qui est le remplacement pour les classeurs partagés.
note: perso, je n'utilise aucun des deux (partage ou co-création)
De quel façon puis je procéder sans passer par la co création ou le partage ? Le but est de pouvoir centraliser les entrées du usf dans un fichier.
Si par exemple chaque utilisateur a son propre fichier avec un usf, est il possible de copier les entrees de tous dans un seul classeur ?
Merci
re,
perso j'aime mieux rapatrier les données de plusieurs fichiers dans un fichier central.
Cest pas mal ce que jaimerais. Cest juste le bout de code a saisir pour copier dans ce cas fi qui serait celui nommer BDD 2019. Actuellement mes données sont copiées sur un onglet dans le classeur batphone 2019. Vs pouvez m'éclairer sur la procédure a faire dans ce cas ?
Merci pour votre aide
Actuellement mes données sont copiées sur un onglet dans le classeur batphone 2019
peux-tu monter le code que tu utilise actuellement ?
re,
Voici un exemple,
Avant d 'exécuter la macro, n'oublie pas de modifier les lignes qui ont un commentaire " à adapter "
nécessite d'activer la référence: Microsoft ActiveX Data Objects xx Library
Sub Read_File_xlsx()
Dim Repertoire As String, Fichier As String, Feuille As String, AddrLire As String
Dim Ligne As Long, oFile As Object
Sheets.Add After:=Sheets(Sheets.Count)
Repertoire = "C:\Users\isabelle\Documents\Test3" 'à adapter
Feuille = "Feuil1" 'à adapter
AddrLire = "A1:D10" 'à adapter
Ligne = 1 'les données sont transférées à partir de la ligne 1 sur la feuille active.
Set fso = CreateObject("Scripting.FileSystemObject")
Set sfofolder = fso.GetFolder(Repertoire)
For Each oFile In sfofolder.Files
If Right(oFile, 5) = ".xlsx" Then 'à adapter
Set Cnn = New ADODB.Connection
'--- Connexion ---
With Cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& oFile & ";Extended Properties=""Excel 12.0;HDR=NO;"""
.Open
End With
'--- récupérer les données --
Set rs = Cnn.Execute("SELECT * FROM [" & Feuille & "$" & AddrLire & "]")
Range("A" & Ligne).CopyFromRecordset rs
rs.Close
Ligne = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row + 1
End If
Next
Cnn.Close
Set rs = Nothing
Set Cnn = Nothing
End SubMerci beaucoup pour ton aide rapide. Je suis un peu tard pour mon code, mais je te le soumets tout de même.
Je vais essayé le code que tu m'a soumis demain.
Ton aide est apprécié merci
Option Explicit
Sub AlimListes(chp As Integer, Optional cible)
Dim d As Object, i%, j, ktl$
Set d = CreateObject("Scripting.Dictionary")
If chp < 4 Then
ktl = "ctl" & chp + 4
Else
ktl = "tbxGuide"
End If
If Not IsMissing(cible) Then
With [Champx]
For i = 1 To .Rows.Count
If .Cells(i, chp - 1) = cible Then
Do While .Cells(i + j, chp - 1) = cible
d(.Cells(i + j, chp).Value) = ""
j = j + 1
Loop
Exit For
End If
Next i
If d.Count > 1 Then
Controls(ktl).List = WorksheetFunction.Transpose(d.keys)
Else
j = d.keys
If chp < 4 Then
Controls(ktl).AddItem j(0)
Else
End If
End If
End With
Else
With [Champx]
For i = 1 To .Rows.Count
d(.Cells(i, chp).Value) = ""
Next i
End With
Controls(ktl).List = WorksheetFunction.Transpose(d.keys)
End If
End Sub
Private Sub cbValid_Click()
Dim c As Control
For Each c In Me.Controls
Select Case TypeName(c)
Case "Ctl5", "Ctl6", "Ctl3", "Ctl4", "ComboBox", "ListBox"
If c.Value = "" Then
MsgBox "Saisir Nom du conseiller, Cat?gories et Sup!"
c.SetFocus
Exit Sub
End If
End Select
Next c
Dim Blt(1 To 8), i%, n%
For i = 3 To 8
Blt(i) = Controls("ctl" & i).Value
Next i
Blt(1) = Date: Blt(2) = Time
With Worksheets("bdd")
n = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Range("A" & n).Resize(, 9).Value = Blt
.Range("A" & n).NumberFormat = "[$-F800]jjjj, mmmm jj, aaaa"
.Range("B" & n).NumberFormat = "hh:mm"
End With
Unload Me
Billet.Show
End Sub
Private Sub ctl1_Change()
End Sub
Private Sub ctl2_Change()
End Sub
Private Sub ctl4_Change()
End Sub
Private Sub ctl5_Click()
ctl6.Clear
ctl7.Clear
If ctl5.ListIndex > -1 Then
ctl6.ListIndex = -1
AlimListes 2, ctl5.Value
End If
End Sub
Private Sub ctl6_Click()
ctl7.Clear
If ctl6.ListIndex > -1 Then
ctl7.ListIndex = -1
AlimListes 3, ctl6.Value
End If
End Sub
Private Sub ctl7_Click()
If ctl7.ListIndex > -1 Then
AlimListes 4, ctl7.Value
End If
End Sub
Private Sub Fermer_Click()
Unload Me
End Sub
Private Sub Reset_Click()
Unload Me
Billet.Show vbModeless
End Sub
Private Sub Image1_Click()
End Sub
Private Sub Label21_Click()
End Sub
Private Sub UserForm_Initialize()
With [Champx].Resize(, 4)
.Sort key1:=.Cells(1, 1), order1:=xlAscending, key2:=.Cells(1, 2), order2:=xlAscending, _
key3:=.Cells(1, 3), order3:=xlAscending, Header:=xlNo
End With
ctl1.Value = Date: ctl2.Value = Format(Time, "hh:mm")
ctl4.ListIndex = -1
AlimListes 1
End SubSalut
J'ai essayé le code que tu m'as soumis, ça fonctionne seulement si le classeur BDD 2019.xlsm est ouvert.
Donc comment faire pour que le code fonctionne sans à avoir le document central d'ouvert ?
re,
Voici un exemple,
Avant d 'exécuter la macro, n'oublie pas de modifier les lignes qui ont un commentaire " à adapter "
nécessite d'activer la référence: Microsoft ActiveX Data Objects xx Library
Sub Read_File_xlsx() Dim Repertoire As String, Fichier As String, Feuille As String, AddrLire As String Dim Ligne As Long, oFile As Object Sheets.Add After:=Sheets(Sheets.Count) Repertoire = "C:\Users\isabelle\Documents\Test3" 'à adapter Feuille = "Feuil1" 'à adapter AddrLire = "A1:D10" 'à adapter Ligne = 1 'les données sont transférées à partir de la ligne 1 sur la feuille active. Set fso = CreateObject("Scripting.FileSystemObject") Set sfofolder = fso.GetFolder(Repertoire) For Each oFile In sfofolder.Files If Right(oFile, 5) = ".xlsx" Then 'à adapter Set Cnn = New ADODB.Connection '--- Connexion --- With Cnn .Provider = "Microsoft.ACE.OLEDB.12.0" .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _ & oFile & ";Extended Properties=""Excel 12.0;HDR=NO;""" .Open End With '--- récupérer les données -- Set rs = Cnn.Execute("SELECT * FROM [" & Feuille & "$" & AddrLire & "]") Range("A" & Ligne).CopyFromRecordset rs rs.Close Ligne = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row + 1 End If Next Cnn.Close Set rs = Nothing Set Cnn = Nothing End Sub
re,
normalement la macro est placée dans le classeur principal,
et pour exécuter la macro, ce classeur doit forcément être ouvert,
tous les autres fichiers (à lire) peuvent rester fermés.
Jaurais un classeur unique a chaque intervenant pour le usf, les donnees usf de ces classeurs seraient transférées dans le classeur central BDD, de ce que je comprenais. Je ne saisis pas dans ce cas le fait que le classeur bdd doit etre ouvert.
re,
ou bien un complément,
https://fr.wikiversity.org/wiki/Macros-commandes_VBA/Cr%C3%A9er_des_macros_compl%C3%A9mentaires
Je comprends de moins en moins ce que je dois faire.
merci quand même pour votre aide