Ecraser des données dans une base de données excel

boulfaledjo

XLDnaute Nouveau
Bonjour,
J'ai un problème assez urgent à vrai dire concernant une base de données que je dois présenter demain apres midi dans le domaine de la santé.

Je me sers d'excel pour créer une base de données à partir d'un formulaire de saisie. ("formulaire de saisie" dans "BDD")

Ce système marche tres bien mis à part qu'on vient de me signaler que les données rentrées dans la BDD sont suceptibles d'etre modifiées régulièrement.

Pour cela j'ai créé un 2eme feuillet formulaire de saisie (avec une macro légèrement modifiée) ("fds2", nom et présentation pas encore finalisés.............) dans lequel:
- je résaisis le No de dossier,
- j'obtiens automatiquement les infos deja entrées
- mais lorsque j'enregistre via la macro, les nouvelles info sont copiées dans la BDD à la suite et non pas ecrasées (et oui c'était le but de la macro de base)

Donc gros problème, bien urgent, que je pense simple, mais je débute complétement en VBA.
Si qlq'un pouvait à modifier la 2eme macro, voire la 1ere qui me permettrait d'avoir seulement un formulaire de saisie qui fait tout (mais bon la j'pense que c'est bcp plus difficile), je lui en serai trestres reconnaissant!!!!

Merci d'avance!
 

Pièces jointes

  • BDD_CO_modif.xls
    46 KB · Affichages: 226

skoobi

XLDnaute Barbatruc
Re : Ecraser des données dans une base de données excel

Bonjour boulfaledjo, bienvenue sur XLD,

voici le premier code modifié qui gère aussi les modifications. Tu ne m'en voudra pas d'avoir enlever les "Select", complètement inutile ici (ça ralentie le code en plus...)

Code:
Sub saisie_formulaire()
Dim TrouveDoss As Range, NumDoss As Range, DerLig As Long
Application.ScreenUpdating = False
Set NumDoss = Range("B2")
'si le numéro de dossier n'est pas vide
If NumDoss.Value <> "" Then
  With Sheets("BDD")
  'on cherche ce numéro dans la BDD colonne 1
    Set TrouveDoss = .Columns(1).Find(NumDoss, LookIn:=xlValues, lookat:=xlWhole)
    'si ce numéro est trouvé
    If Not TrouveDoss Is Nothing Then
      TrouveDoss.Resize(1, 22).Value = Application.Transpose(NumDoss.Resize(22, 1))
    'si le numéro n'est pas trouvé on identifie la dernière ligne pour écrire à la suite
    Else
      DerLig = .Range("A65536").End(xlUp).Row + 1
      .Range("A" & DerLig).Resize(1, 22).Value = Application.Transpose(NumDoss.Resize(22, 1))
    End If
  End With
End If
'Rendre le formulaire vierge et revenir à la première cellule
Range("B2:B23").ClearContents
Application.ScreenUpdating = True
End Sub
Bon test.
 

Discussions similaires