Transfert données - Message Erreur

Le
J&B
Bonjour,

J'utilise la macro ci dessous pour transferer des données d'une feuille
formulaire vers une BDD
Je voudrai ajouter que lorsqu'il y a un champ vide un message d'erreur
apparaise pour valider ou ne pas valider le transfert
Merci de votre aide
j@b


Sub CreationBDD()
Dim Data(6) As String

Dim Last_LGN As Double
With Sheets("Formulaire")

Data(0) = .Cells(1, 2)
Data(1) = .Cells(2, 2)
Data(2) = .Cells(3, 2)
Data(3) = .Cells(4, 2)
Data(4) = .Cells(5, 2)
Data(5) = .Cells(6, 2)

.Cells(1, 2) = ""
.Cells(2, 2) = ""
.Cells(3, 2) = ""
.Cells(4, 2) = ""
.Cells(5, 2) = ""
.Cells(6, 2) = ""



End With
For x = 0 To UBound(Data)
If Len(Data(x)) = 0 Then ouch = ouch + 1
Next
If ouch - 1 = UBound(Data) Then Exit Sub

With Sheets("Data")
Last_LGN = .Cells(65536, 1).End(xlUp).Row + 1
.Range(.Cells(Last_LGN, 1), .Cells(Last_LGN, 6)).Value = Data
' .Cells(Last_LGN, 1).Value =
Application.WorksheetFunction.Max(.Range(.Cells(1, 1), .Cells(Last_LGN, 1)))
+ 1
End With
End Sub
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Daniel.C
Le #17533081
Bonjour.
Pas sûr d'avoir bien compris. Esssaie :

Sub CreationBDD()
Dim Data(6) As String

Dim Last_LGN As Double
With Sheets("Formulaire")

Data(0) = .Cells(1, 2)
Data(1) = .Cells(2, 2)
Data(2) = .Cells(3, 2)
Data(3) = .Cells(4, 2)
Data(4) = .Cells(5, 2)
Data(5) = .Cells(6, 2)

.Cells(1, 2) = ""
.Cells(2, 2) = ""
.Cells(3, 2) = ""
.Cells(4, 2) = ""
.Cells(5, 2) = ""
.Cells(6, 2) = ""


If Application.CountA(.Range("B1:B6")) < 6 Then
MsgBox "Cellule vide"
Exit Sub
End If
End With
For x = 0 To UBound(Data)
If Len(Data(x)) = 0 Then ouch = ouch + 1
Next
If ouch - 1 = UBound(Data) Then Exit Sub

With Sheets("Data")
Last_LGN = .Cells(65536, 1).End(xlUp).Row + 1
.Range(.Cells(Last_LGN, 1), .Cells(Last_LGN, 6)).Value = Data
'.Cells(Last_LGN, 1).Value
=Application.WorksheetFunction.Max(.Range(.Cells(1, 1), .Cells(Last_LGN,
1))) + 1
End With
End Sub

--
Cordialement.
Daniel
"J&B" 48f4beb0$0$25687$
Bonjour,

J'utilise la macro ci dessous pour transferer des données d'une feuille
formulaire vers une BDD
Je voudrai ajouter que lorsqu'il y a un champ vide un message d'erreur
apparaise pour valider ou ne pas valider le transfert
Merci de votre aide



Sub CreationBDD()
Dim Data(6) As String

Dim Last_LGN As Double
With Sheets("Formulaire")

Data(0) = .Cells(1, 2)
Data(1) = .Cells(2, 2)
Data(2) = .Cells(3, 2)
Data(3) = .Cells(4, 2)
Data(4) = .Cells(5, 2)
Data(5) = .Cells(6, 2)

.Cells(1, 2) = ""
.Cells(2, 2) = ""
.Cells(3, 2) = ""
.Cells(4, 2) = ""
.Cells(5, 2) = ""
.Cells(6, 2) = ""



End With
For x = 0 To UBound(Data)
If Len(Data(x)) = 0 Then ouch = ouch + 1
Next
If ouch - 1 = UBound(Data) Then Exit Sub

With Sheets("Data")
Last_LGN = .Cells(65536, 1).End(xlUp).Row + 1
.Range(.Cells(Last_LGN, 1), .Cells(Last_LGN, 6)).Value = Data
' .Cells(Last_LGN, 1).Value =
Application.WorksheetFunction.Max(.Range(.Cells(1, 1), .Cells(Last_LGN,
1))) + 1
End With
End Sub



Daniel.C
Le #17536951
Remplace cette ligne par :

For i = 1 To 6
If .Cells(i, 2) = "" Then
MsgBox "Cellule vide"
Exit Sub
End If
Next i

Daniel
"J&B" 48f5f510$0$15722$
Bonjour,

Merci mais ne marche pas
car si les cellules B1:B6 sont bien renseignées on obtient toujours le
message d'erreur
J'ai essayé avec <= ou avec 5 mais rien n'y fait
%erci pour votre aide
j&b



"Daniel.C" 48f5b0e5$0$12606$
Bonjour.
Pas sûr d'avoir bien compris. Esssaie :

Sub CreationBDD()
Dim Data(6) As String

Dim Last_LGN As Double
With Sheets("Formulaire")

Data(0) = .Cells(1, 2)
Data(1) = .Cells(2, 2)
Data(2) = .Cells(3, 2)
Data(3) = .Cells(4, 2)
Data(4) = .Cells(5, 2)
Data(5) = .Cells(6, 2)

.Cells(1, 2) = ""
.Cells(2, 2) = ""
.Cells(3, 2) = ""
.Cells(4, 2) = ""
.Cells(5, 2) = ""
.Cells(6, 2) = ""


If Application.CountA(.Range("B1:B6")) < 6 Then
MsgBox "Cellule vide"
Exit Sub
End If
End With
For x = 0 To UBound(Data)
If Len(Data(x)) = 0 Then ouch = ouch + 1
Next
If ouch - 1 = UBound(Data) Then Exit Sub

With Sheets("Data")
Last_LGN = .Cells(65536, 1).End(xlUp).Row + 1
.Range(.Cells(Last_LGN, 1), .Cells(Last_LGN, 6)).Value = Data
'.Cells(Last_LGN, 1).Value
=Application.WorksheetFunction.Max(.Range(.Cells(1, 1), .Cells(Last_LGN,
1))) + 1
End With
End Sub

--
Cordialement.
Daniel
"J&B" 48f4beb0$0$25687$
Bonjour,

J'utilise la macro ci dessous pour transferer des données d'une feuille
formulaire vers une BDD
Je voudrai ajouter que lorsqu'il y a un champ vide un message d'erreur
apparaise pour valider ou ne pas valider le transfert
Merci de votre aide



Sub CreationBDD()
Dim Data(6) As String

Dim Last_LGN As Double
With Sheets("Formulaire")

Data(0) = .Cells(1, 2)
Data(1) = .Cells(2, 2)
Data(2) = .Cells(3, 2)
Data(3) = .Cells(4, 2)
Data(4) = .Cells(5, 2)
Data(5) = .Cells(6, 2)

.Cells(1, 2) = ""
.Cells(2, 2) = ""
.Cells(3, 2) = ""
.Cells(4, 2) = ""
.Cells(5, 2) = ""
.Cells(6, 2) = ""



End With
For x = 0 To UBound(Data)
If Len(Data(x)) = 0 Then ouch = ouch + 1
Next
If ouch - 1 = UBound(Data) Then Exit Sub

With Sheets("Data")
Last_LGN = .Cells(65536, 1).End(xlUp).Row + 1
.Range(.Cells(Last_LGN, 1), .Cells(Last_LGN, 6)).Value = Data
' .Cells(Last_LGN, 1).Value =
Application.WorksheetFunction.Max(.Range(.Cells(1, 1), .Cells(Last_LGN,
1))) + 1
End With
End Sub











J&B
Le #17536831
Bonjour,

Merci mais ne marche pas
car si les cellules B1:B6 sont bien renseignées on obtient toujours le
message d'erreur
J'ai essayé avec <= ou avec 5 mais rien n'y fait
%erci pour votre aide
j&b



"Daniel.C" 48f5b0e5$0$12606$
Bonjour.
Pas sûr d'avoir bien compris. Esssaie :

Sub CreationBDD()
Dim Data(6) As String

Dim Last_LGN As Double
With Sheets("Formulaire")

Data(0) = .Cells(1, 2)
Data(1) = .Cells(2, 2)
Data(2) = .Cells(3, 2)
Data(3) = .Cells(4, 2)
Data(4) = .Cells(5, 2)
Data(5) = .Cells(6, 2)

.Cells(1, 2) = ""
.Cells(2, 2) = ""
.Cells(3, 2) = ""
.Cells(4, 2) = ""
.Cells(5, 2) = ""
.Cells(6, 2) = ""


If Application.CountA(.Range("B1:B6")) < 6 Then
MsgBox "Cellule vide"
Exit Sub
End If
End With
For x = 0 To UBound(Data)
If Len(Data(x)) = 0 Then ouch = ouch + 1
Next
If ouch - 1 = UBound(Data) Then Exit Sub

With Sheets("Data")
Last_LGN = .Cells(65536, 1).End(xlUp).Row + 1
.Range(.Cells(Last_LGN, 1), .Cells(Last_LGN, 6)).Value = Data
'.Cells(Last_LGN, 1).Value
=Application.WorksheetFunction.Max(.Range(.Cells(1, 1), .Cells(Last_LGN,
1))) + 1
End With
End Sub

--
Cordialement.
Daniel
"J&B" 48f4beb0$0$25687$
Bonjour,

J'utilise la macro ci dessous pour transferer des données d'une feuille
formulaire vers une BDD
Je voudrai ajouter que lorsqu'il y a un champ vide un message d'erreur
apparaise pour valider ou ne pas valider le transfert
Merci de votre aide



Sub CreationBDD()
Dim Data(6) As String

Dim Last_LGN As Double
With Sheets("Formulaire")

Data(0) = .Cells(1, 2)
Data(1) = .Cells(2, 2)
Data(2) = .Cells(3, 2)
Data(3) = .Cells(4, 2)
Data(4) = .Cells(5, 2)
Data(5) = .Cells(6, 2)

.Cells(1, 2) = ""
.Cells(2, 2) = ""
.Cells(3, 2) = ""
.Cells(4, 2) = ""
.Cells(5, 2) = ""
.Cells(6, 2) = ""



End With
For x = 0 To UBound(Data)
If Len(Data(x)) = 0 Then ouch = ouch + 1
Next
If ouch - 1 = UBound(Data) Then Exit Sub

With Sheets("Data")
Last_LGN = .Cells(65536, 1).End(xlUp).Row + 1
.Range(.Cells(Last_LGN, 1), .Cells(Last_LGN, 6)).Value = Data
' .Cells(Last_LGN, 1).Value =
Application.WorksheetFunction.Max(.Range(.Cells(1, 1), .Cells(Last_LGN,
1))) + 1
End With
End Sub







J&B
Le #17537971
Désolé
mais ça ne marche toujours pas
lorsque les champs sont bien tous saisies
j'ai toujours le message d'erreur "cellule vide"

merci quand meme



"Daniel.C"
Remplace cette ligne par :

For i = 1 To 6
If .Cells(i, 2) = "" Then
MsgBox "Cellule vide"
Exit Sub
End If
Next i

Daniel
"J&B" 48f5f510$0$15722$
Bonjour,

Merci mais ne marche pas
car si les cellules B1:B6 sont bien renseignées on obtient toujours le
message d'erreur
J'ai essayé avec <= ou avec 5 mais rien n'y fait
%erci pour votre aide
j&b



"Daniel.C" 48f5b0e5$0$12606$
Bonjour.
Pas sûr d'avoir bien compris. Esssaie :

Sub CreationBDD()
Dim Data(6) As String

Dim Last_LGN As Double
With Sheets("Formulaire")

Data(0) = .Cells(1, 2)
Data(1) = .Cells(2, 2)
Data(2) = .Cells(3, 2)
Data(3) = .Cells(4, 2)
Data(4) = .Cells(5, 2)
Data(5) = .Cells(6, 2)

.Cells(1, 2) = ""
.Cells(2, 2) = ""
.Cells(3, 2) = ""
.Cells(4, 2) = ""
.Cells(5, 2) = ""
.Cells(6, 2) = ""


If Application.CountA(.Range("B1:B6")) < 6 Then
MsgBox "Cellule vide"
Exit Sub
End If
End With
For x = 0 To UBound(Data)
If Len(Data(x)) = 0 Then ouch = ouch + 1
Next
If ouch - 1 = UBound(Data) Then Exit Sub

With Sheets("Data")
Last_LGN = .Cells(65536, 1).End(xlUp).Row + 1
.Range(.Cells(Last_LGN, 1), .Cells(Last_LGN, 6)).Value = Data
'.Cells(Last_LGN, 1).Value
=Application.WorksheetFunction.Max(.Range(.Cells(1, 1), .Cells(Last_LGN,
1))) + 1
End With
End Sub

--
Cordialement.
Daniel
"J&B" 48f4beb0$0$25687$
Bonjour,

J'utilise la macro ci dessous pour transferer des données d'une feuille
formulaire vers une BDD
Je voudrai ajouter que lorsqu'il y a un champ vide un message d'erreur
apparaise pour valider ou ne pas valider le transfert
Merci de votre aide



Sub CreationBDD()
Dim Data(6) As String

Dim Last_LGN As Double
With Sheets("Formulaire")

Data(0) = .Cells(1, 2)
Data(1) = .Cells(2, 2)
Data(2) = .Cells(3, 2)
Data(3) = .Cells(4, 2)
Data(4) = .Cells(5, 2)
Data(5) = .Cells(6, 2)

.Cells(1, 2) = ""
.Cells(2, 2) = ""
.Cells(3, 2) = ""
.Cells(4, 2) = ""
.Cells(5, 2) = ""
.Cells(6, 2) = ""



End With
For x = 0 To UBound(Data)
If Len(Data(x)) = 0 Then ouch = ouch + 1
Next
If ouch - 1 = UBound(Data) Then Exit Sub

With Sheets("Data")
Last_LGN = .Cells(65536, 1).End(xlUp).Row + 1
.Range(.Cells(Last_LGN, 1), .Cells(Last_LGN, 6)).Value = Data
' .Cells(Last_LGN, 1).Value =
Application.WorksheetFunction.Max(.Range(.Cells(1, 1), .Cells(Last_LGN,
1))) + 1
End With
End Sub















J&B
Le #17537961
J'ai trouvé !!!!!!!!!!!!!!!!

Ton code est bon mais il faut le positionner juste après

Data(0) = .Cells(1, 2)
Data(1) = .Cells(2, 2)
Data(2) = .Cells(3, 2)
Data(3) = .Cells(4, 2)
Data(4) = .Cells(5, 2)
Data(5) = .Cells(6, 2)










Merci de ton aide
A bientôt



"J&B" 48f6164c$0$19313$
Désolé
mais ça ne marche toujours pas
lorsque les champs sont bien tous saisies
j'ai toujours le message d'erreur "cellule vide"

merci quand meme



"Daniel.C"
Remplace cette ligne par :

For i = 1 To 6
If .Cells(i, 2) = "" Then
MsgBox "Cellule vide"
Exit Sub
End If
Next i

Daniel
"J&B" 48f5f510$0$15722$
Bonjour,

Merci mais ne marche pas
car si les cellules B1:B6 sont bien renseignées on obtient toujours le
message d'erreur
J'ai essayé avec <= ou avec 5 mais rien n'y fait
%erci pour votre aide
j&b



"Daniel.C" 48f5b0e5$0$12606$
Bonjour.
Pas sûr d'avoir bien compris. Esssaie :

Sub CreationBDD()
Dim Data(6) As String

Dim Last_LGN As Double
With Sheets("Formulaire")

Data(0) = .Cells(1, 2)
Data(1) = .Cells(2, 2)
Data(2) = .Cells(3, 2)
Data(3) = .Cells(4, 2)
Data(4) = .Cells(5, 2)
Data(5) = .Cells(6, 2)

.Cells(1, 2) = ""
.Cells(2, 2) = ""
.Cells(3, 2) = ""
.Cells(4, 2) = ""
.Cells(5, 2) = ""
.Cells(6, 2) = ""


If Application.CountA(.Range("B1:B6")) < 6 Then
MsgBox "Cellule vide"
Exit Sub
End If
End With
For x = 0 To UBound(Data)
If Len(Data(x)) = 0 Then ouch = ouch + 1
Next
If ouch - 1 = UBound(Data) Then Exit Sub

With Sheets("Data")
Last_LGN = .Cells(65536, 1).End(xlUp).Row + 1
.Range(.Cells(Last_LGN, 1), .Cells(Last_LGN, 6)).Value = Data
'.Cells(Last_LGN, 1).Value
=Application.WorksheetFunction.Max(.Range(.Cells(1, 1),
.Cells(Last_LGN, 1))) + 1
End With
End Sub

--
Cordialement.
Daniel
"J&B" 48f4beb0$0$25687$
Bonjour,

J'utilise la macro ci dessous pour transferer des données d'une
feuille formulaire vers une BDD
Je voudrai ajouter que lorsqu'il y a un champ vide un message d'erreur
apparaise pour valider ou ne pas valider le transfert
Merci de votre aide



Sub CreationBDD()
Dim Data(6) As String

Dim Last_LGN As Double
With Sheets("Formulaire")

Data(0) = .Cells(1, 2)
Data(1) = .Cells(2, 2)
Data(2) = .Cells(3, 2)
Data(3) = .Cells(4, 2)
Data(4) = .Cells(5, 2)
Data(5) = .Cells(6, 2)

.Cells(1, 2) = ""
.Cells(2, 2) = ""
.Cells(3, 2) = ""
.Cells(4, 2) = ""
.Cells(5, 2) = ""
.Cells(6, 2) = ""



End With
For x = 0 To UBound(Data)
If Len(Data(x)) = 0 Then ouch = ouch + 1
Next
If ouch - 1 = UBound(Data) Then Exit Sub

With Sheets("Data")
Last_LGN = .Cells(65536, 1).End(xlUp).Row + 1
.Range(.Cells(Last_LGN, 1), .Cells(Last_LGN, 6)).Value = Data
' .Cells(Last_LGN, 1).Value =
Application.WorksheetFunction.Max(.Range(.Cells(1, 1),
.Cells(Last_LGN, 1))) + 1
End With
End Sub



















Publicité
Poster une réponse
Anonyme