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
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
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
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" a écrit dans le message de news:
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" a écrit dans le message de news:
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
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" <dcolardelleZZZZ@free.fr> a écrit dans le message de news:
48f5b0e5$0$12606$426a74cc@news.free.fr...
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" <jb@free.fr> a écrit dans le message de news:
48f4beb0$0$25687$426a34cc@news.free.fr...
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
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" a écrit dans le message de news:
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" a écrit dans le message de news:
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
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" a écrit dans le message de news:
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
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" <jb@free.fr> a écrit dans le message de news:
48f4beb0$0$25687$426a34cc@news.free.fr...
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
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" a écrit dans le message de news:
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
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" a écrit dans le message de news:
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" a écrit dans le message de news:
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" a écrit dans le message de news:
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
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" <jb@free.fr> a écrit dans le message de news:
48f5f510$0$15722$426a74cc@news.free.fr...
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" <dcolardelleZZZZ@free.fr> a écrit dans le message de news:
48f5b0e5$0$12606$426a74cc@news.free.fr...
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" <jb@free.fr> a écrit dans le message de news:
48f4beb0$0$25687$426a34cc@news.free.fr...
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
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" a écrit dans le message de news:
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" a écrit dans le message de news:
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" a écrit dans le message de news:
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
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)
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" a écrit dans le message de news: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" a écrit dans le message de news:
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" a écrit dans le message de news:
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" a écrit dans le message de news:
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
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)
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" <dZZZcolardelle@free.fr> a écrit dans le message de news:
uWNXg5sLJHA.1308@TK2MSFTNGP02.phx.gbl...
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" <jb@free.fr> a écrit dans le message de news:
48f5f510$0$15722$426a74cc@news.free.fr...
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" <dcolardelleZZZZ@free.fr> a écrit dans le message de news:
48f5b0e5$0$12606$426a74cc@news.free.fr...
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" <jb@free.fr> a écrit dans le message de news:
48f4beb0$0$25687$426a34cc@news.free.fr...
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
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)
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" a écrit dans le message de news: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" a écrit dans le message de news:
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" a écrit dans le message de news:
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" a écrit dans le message de news:
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