Transfert données

[silver.beach]

Bonjour à tous,

J'utilise un formulaire de saisie (userform excel) avec des boutons, je souhaiterai que quand j'appui sur le bouton une information texte s'incrémente dans un autre fichier excel (base de données).

Le problème qui se pose c'est que a chaque fois que je clique sur un bouton, le fichier "Base de données" me marque:

" BaseDeDonnées.xls est déja ouvert. Si vous l'ouvrer à nouveau, toutes vos modifications seront perdues. Voulez-vous rouvrir BaseDeDonnées.xls ? "

Du coup je ne peux pas faire ma saisie complete !!

Voila le code que j'utilise :

'Copie des données service
Sub CopieDesDonnées(service)
Workbooks.Open "K:\Repertoire Commun\Arnaud\Excel\VBA\BaseDeDonnées.xls" 'Ouverture base de données
Application.ScreenUpdating = False
Workbooks("BaseDeDonnées").Activate

If Worksheets("Base de données").Range("B1").End(xlDown).Row > 65500 Then
Worksheets("Base de données").Range("B2").Value = service
Else
If Worksheets("Base de données").Range("A1").End(xlDown).Row = Worksheets("Base de données").Range("C1").End(xlDown).Row Then
Worksheets("Base de données").Range("B1").End(xlDown).Offset(1, 0).Value = service
Else
Worksheets("Base de données").Range("B1").End(xlDown).Value = service
End If
End If
Worksheets("Base de données").Activate
Application.ScreenUpdating = True
End Sub

 

[youky(BJ)]

Re : Transfert données

Bonsoir,
voici une petite solution
On gère l'erreur et on y va direct
Activation du fichier comme s'il était ouvert, si une erreur est detectée, c'est qu'il est fermé sinon on l'ouvre

Bruno


On Error Resume Next
Workbooks("BaseDeDonnées.xls").Activate
If Err.Number = 9 Then
Err = 0
Workbooks.Open "K:\RepertoireCommun\Arnaud\Excel\VBA\BaseDeDonnées.xls"
End If
If Worksheets("Base ..........et la suite

 

[Hulk]

Re : Transfert données

Hello,

Sans avoir testé, essaie comme ça.

Sub CopieDesDonnées(service)
    
Dim Worbk As Workbook

On Error Resume Next

Set Worbk = Workbooks("Base de données.xls")

On Error GoTo 0

If Worbk Is Nothing Then
    Application.ScreenUpdating = False
    Workbooks.Open "K:\Repertoire Commun\Arnaud\Excel\VBA\BaseDeDonnées.xls"
    Workbooks("Base de données.xls").Activate
    If Worksheets("Base de données").Range("B1").End(xlDown).Row > 65500 Then
        Worksheets("Base de données").Range("B2").Value = service
    Else
        If Worksheets("Base de données").Range("A1").End(xlDown).Row = Worksheets("Base de données").Range("C1").End(xlDown).Row Then
            Worksheets("Base de données").Range("B1").End(xlDown).Offset(1, 0).Value = service
        Else
            Worksheets("Base de données").Range("B1").End(xlDown).Value = service
        End If
    End If
    Worksheets("Base de données").Activate
    Application.ScreenUpdating = True
Else
    Set Worbk = Nothing
    MsgBox "Ce classeur est déjà ouvert !"
    Workbooks("Base de données.xls").Activate
    Worksheets("Base de données").Activate
End If

End Sub

Source (site dj.ross.free.fr) ci dessous

Sub OuvreSiPasOuvert()
Dim Worbk As Workbook
On Error Resume Next
Set Worbk = Workbooks("Test.xls")
On Error GoTo 0
If Worbk Is Nothing Then Workbooks.Open "C:\ajeter\Test.xls" _
Else Set Worbk = Nothing
End Sub

EDIT : Oups slt Youky
EDIT 2 : J'ai rajouté une petite MsgBox au code