jager57
Messages postés27Date d'inscriptionmardi 19 décembre 2000StatutMembreDernière intervention22 août 2008
-
20 août 2008 à 08:14
jager57
Messages postés27Date d'inscriptionmardi 19 décembre 2000StatutMembreDernière intervention22 août 2008
-
20 août 2008 à 15:50
Bonjour, <?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /??>
Je suis débutant en VBA
JŽai réalisé un programme lorquŽon tape un numéro de schéma, il se réfère à la ligne correspondante mais en plusieurs messages box. Cet macro jŽai eu du mal à la réaliser
Es ce possible de mettre tous les renseignements en un seul message box
voici une parti de mon tableau
<colgroup><col style=\"WIDTH: 20pt; mso-width-source: userset; mso-width-alt: 950\" width=\"26\" /><col style=\"WIDTH: 75pt; mso-width-source: userset; mso-width-alt: 3657\" width=\"100\" /><col style=\"WIDTH: 34pt; mso-width-source: userset; mso-width-alt: 1645\" width=\"45\" /><col style=\"WIDTH: 37pt; mso-width-source: userset; mso-width-alt: 1792\" width=\"49\" /><col style=\"WIDTH: 60pt\" span=\"2\" width=\"80\" /><col style=\"WIDTH: 16pt; mso-width-source: userset; mso-width-alt: 768\" width=\"21\" /><col style=\"WIDTH: 41pt; mso-width-source: userset; mso-width-alt: 1974\" width=\"54\" /><col style=\"WIDTH: 232pt; mso-width-source: userset; mso-width-alt: 11300\" width=\"309\" /><col style=\"WIDTH: 54pt; mso-width-source: userset; mso-width-alt: 2633\" width=\"72\" /><col style=\"WIDTH: 66pt; mso-width-source: userset; mso-width-alt: 3218\" width=\"88\" /></colgroup>----
X, Zeichnung.Nr, X, Index, Zeichn.Nr, Artikel.Nr, , Modell, Name, Datum, Bemerkung, ----
N, 011-1-91, N, , , , N, , le soleil, 01.09.91, , ----
N, 012-1-91, N, A, , , N, , les nuages, 10.08.91, , ----
N, 013-1-91, N, A, , , N, , le ciel, 14.08.91, , ----
N, 014-1-91, N, A, , , N, , les arbres, 22.08.91, , ----
N, 015-0-91, N, , , , N, , les oiseaux, 12.08.91, , ----
N, 016-0-91, N, A, , , N, , les animaux, 22.08.91, , ----
-, 13-1-93, , , , A0252, , , les singes, 11.11.93, , ----
J, 14-1-93, J, , 014-1-93, A0263, , , les renards, , , ----
N, 16-4-94, N, A, , , N, , la lune, 05.01.94, , ----
, 17-4-94, , , , , U, , chien, 06.01.94, nicht ausgeführt, ----
J, 18-4-94, J, A, 018-4-94 A, E5011 , X, 001, chat, 20.01.94, , ----
J, 18-4-94, J, A, 018-4-94 A, E5014, , , chat, , , ----
, 19-4-94, , , , , U, , poisson, 17.03.94, nicht ausgeführt
Sub Obtenirlaréférence2()
Dim msg As String
Dim Réponse As Integer
Dim articlederéférence As String
Dim croix As String
Dim modell As String
Dim croix1 As String
On Error GoTo Erreur
Réessayer:
Application.ScreenUpdating = False
Sheets("Tabelle1").Activate
Numpièce = InputBox("die Zeichnungnummer : ")
If Numpièce = "" Then GoTo Erreur
Sheets("Tabelle1").Range("B3").Select
Do
ActiveCell.Offset(1, 0).Select
nomdeschématest = WorksheetFunction.VLookup(Numpièce, Range("tableau"), 8, False)
If nomdeschématest "" Then msg MsgBox("die Zeichnung ist unbekannt", vbyesonly) If ActiveCell.Value Numpièce Then Nomdeschéma ActiveCell.Offset(0, 7).Value
If ActiveCell.Value = Numpièce Then MsgBox "die Zeichnung " & Numpièce & " heißt " & Nomdeschéma If ActiveCell.Value Numpièce Then croix ActiveCell.Offset(0, 1).Value If croix "N" And ActiveCell.Value Numpièce Then MsgBox "die Zeichnung hat keine Artikelnummer" If croix "" And ActiveCell.Value Numpièce Then MsgBox "aber die Zeichnung ist ungültig" If croix "J" Or croix "-" And ActiveCell.Value = Numpièce Then articlederéférence = ActiveCell.Offset(0, 4).Value If ActiveCell.Value Numpièce And croix "J" Or croix = "-" Then MsgBox "die Zeichnung " & Numpièce & " hat eine Artikelnummer " & articlederéférence If ActiveCell.Value Numpièce Then croix1 ActiveCell.Offset(0, 5).Value If croix1 "" And ActiveCell.Value Numpièce Then MsgBox " und viel modell " If croix1 "N" And ActiveCell.Value Numpièce Then msg = "" If croix1 "U" And ActiveCell.Value Numpièce Then msg = "" If croix1 "X" And ActiveCell.Value Numpièce Then MsgBox " und ein modell " & modell
Loop While ActiveCell.Value <> Empty
Exit Sub
Erreur: If Nomdeschéma "" Or Numpièce "" Then msg = " die Zeichnung ist unbekannt. Wiederversuchen? "
Réponse = MsgBox(msg, vbYesNo)
If Réponse = vbYes Then GoTo Réessayer
If Réponse = vbNo Then Exit Sub
If Réponse = vbCancel Then Exit Sub
jrivet
Messages postés7393Date d'inscriptionmercredi 23 avril 2003StatutMembreDernière intervention 6 avril 201260 20 août 2008 à 09:42
Re,
Peux tu essayer de continuer la discution plutôt que par MP s'il te plait?
Peux tu aussi répondre aux questions (=> traduire les textes allemands)
plutôt que de vouloir directement m'envoyer ton Excel...
tu peux toujours stocker le contenu des MSgbox dans une variable String et ne faire qu'UNE seule Msgbox à la fin. mais vu que je ne comprends pas l'allemand je ne sais pas si c'est que tu cherches à faire ou pas.
</td>
<td class="xl46" style="BORDER-RIGHT: black 1pt solid; BORDER-TOP: black; BORDER-LEFT: black; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: red">
</td>
<td class="xl46" style="BORDER-RIGHT: black 1pt solid; BORDER-TOP: black; BORDER-LEFT: black; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: red">
</td>
<td class="xl46" style="BORDER-RIGHT: black 1pt solid; BORDER-TOP: black; BORDER-LEFT: black; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: red">
</td>
<td class="xl46" style="BORDER-RIGHT: black 1pt solid; BORDER-TOP: black; BORDER-LEFT: black; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: red">
U
</td>
<td class="xl45" style="BORDER-RIGHT: black 1pt solid; BORDER-TOP: black; BORDER-LEFT: black; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: red">
</td>
<td class="xl46" style="BORDER-RIGHT: black 1pt solid; BORDER-TOP: black; BORDER-LEFT: black; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: red">
poisson
</td>
<td class="xl47" style="BORDER-RIGHT: black 1pt solid; BORDER-TOP: black; BORDER-LEFT: black; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: red" x="">
17.03.94
</td>
<td class="xl48" style="BORDER-RIGHT: black 1pt solid; BORDER-TOP: black; BORDER-LEFT: black; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: red">
nŽexiste plus
</td>
</tr>
</tbody>
</table>
Sub Obtenirlaréférence2()
Dim msg As String
Dim Reponse As Integer
Dim articledereference As String
Dim croix As String
Dim modell As String
Dim croix1 As String
On Error GoTo Erreur
Reessayer:
Application.ScreenUpdating = False
Sheets("Tabelle1").Activate
Numpiece = InputBox("le nom de schéma : ")
If Numpiece = "" Then GoTo Erreur
Sheets("Tabelle1").Range("B3").Select
Do
ActiveCell.Offset(1, 0).Select
nomdeschematest = WorksheetFunction.VLookup(Numpiece, Range("tableau"), 8, False)
If nomdeschematest "" Then msg MsgBox("le schéma est inconnu", vbyesonly) If ActiveCell.Value Numpiece Then Nomdeschema ActiveCell.Offset(0, 7).Value
If ActiveCell.Value = Numpiece Then MsgBox "le schéma " & Numpiece & " sŽapelle " & Nomdeschema If ActiveCell.Value Numpiece Then croix ActiveCell.Offset(0, 1).Value If croix "N" And ActiveCell.Value Numpiece Then MsgBox "le schéma nŽa aucun numéro dŽarticles" If croix "" And ActiveCell.Value Numpiece Then MsgBox "mais le schéma nŽexiste plus" If croix "J" Or croix "-" And ActiveCell.Value = Numpiece Then articledereference = ActiveCell.Offset(0, 4).Value If ActiveCell.Value Numpiece And croix "J" Or croix = "-" Then MsgBox "le schéma " & Numpiece & " a un numéro dŽarticles " & articledereference If ActiveCell.Value Numpiece Then croix1 ActiveCell.Offset(0, 5).Value If croix1 "" And ActiveCell.Value Numpiece Then MsgBox " et à plusieurs modèles " If croix1 "N" And ActiveCell.Value Numpiece Then msg = "" If croix1 "U" And ActiveCell.Value Numpiece Then msg = "" If croix1 "X" And ActiveCell.Value Numpiece Then MsgBox " et à un modèle " & modell
Loop While ActiveCell.Value <> Empty
Exit Sub
Erreur: If Nomdeschema "" Or Numpiece "" Then msg = " le schéma est inconnu.réessayer? "
Reponse = MsgBox(msg, vbYesNo)
If Réponse = vbYes Then GoTo Reessayer
If Réponse = vbNo Then Exit Sub
If Réponse = vbCancel Then Exit Sub
jrivet
Messages postés7393Date d'inscriptionmercredi 23 avril 2003StatutMembreDernière intervention 6 avril 201260 20 août 2008 à 10:03
Re,
Je ne sais pas si c'est ce que tu cherches mais regarde ceci.
NOTE: inutile de m'envoyer un MP pour me dire que tu as répondu, je recoit
un mail automatiquement.
Sub Obtenirlaréférence2()
Dim msg As String
Dim Reponse As VbMsgBoxResult
Dim articledereference As String
Dim croix As String
Dim modell As String
Dim croix1 As String
On Error GoTo Erreur
Reessayer:
Application.ScreenUpdating = False
Sheets("Tabelle1").Activate
Numpiece = InputBox("le nom de schéma : ")
If Numpiece = vbNullString Then GoTo Erreur
Sheets("Tabelle1").Range("B3").Select
Do
ActiveCell.Offset(1, 0).Select
nomdeschematest = WorksheetFunction.VLookup(Numpiece, Range("tableau"), 8, False)
If nomdeschematest vbNullString Then msg "le schéma est inconnu"
If ActiveCell.Value Numpiece Then Nomdeschema ActiveCell.Offset(0, 7).Value If ActiveCell.Value Numpiece Then msg "le schéma " & Numpiece & " s'apelle " & Nomdeschema If ActiveCell.Value Numpiece Then croix ActiveCell.Offset(0, 1).Value
If croix "N" And ActiveCell.Value Numpiece Then msg = msg & vbCrLf & "le schéma n'a aucun numéro d'articles" If croix vbNullString And ActiveCell.Value Numpiece Then msg = msg & vbCrLf & "mais le schéma n'existe plus" If croix "J" Or croix "-" And ActiveCell.Value = Numpiece Then articledereference = ActiveCell.Offset(0, 4).Value
If ActiveCell.Value Numpiece And croix "J" Or croix = "-" Then msg = msg & vbCrLf & "le schéma " & Numpiece & " a un numéro d'articles " & articledereference If ActiveCell.Value Numpiece Then croix1 ActiveCell.Offset(0, 5).Value
If croix1 vbNullString And ActiveCell.Value Numpiece Then msg = msg & vbCrLf & " et à plusieurs modèles " If croix1 "N" And ActiveCell.Value Numpiece Then msg = msg & vbCrLf & vbNullString If croix1 "U" And ActiveCell.Value Numpiece Then msg = msg & vbCrLf & vbNullString If croix1 "X" And ActiveCell.Value Numpiece Then msg = msg & vbCrLf & " et à un modèle " & modell
Call MsgBox(msg, vbOKOnly)
Loop While ActiveCell.Value <> Empty
Exit Sub
Erreur: If Nomdeschema vbNullString Or Numpiece vbNullString Then msg = " le schéma est inconnu.réessayer? "
Reponse = MsgBox(msg, vbYesNo)
If Reponse = vbYes Then GoTo Reessayer
'If Reponse = vbNo Then Exit Sub '=> inutile aussi puisque il sortira si reponse <> vbyes
'If Reponse = vbCancel Then Exit Sub 'NB=> Si tu met vbYesNo => Reponse ne vaudra JAMAIS VbCancel donc inutile
End Sub<hr />, ----
[code.aspx?ID=41455 By Renfield]
jrivet
Messages postés7393Date d'inscriptionmercredi 23 avril 2003StatutMembreDernière intervention 6 avril 201260 20 août 2008 à 10:37
Re,
ARRETE AVEC LES MP (dernière fois sinon j'arrête de t'aider) reponds ICI
Essaie peu être de mettre le Call MsgBox(msg, vbOKOnly) apres la boucle
"merci ca marche
mais ii y a un problème qund je tape le nom du schéma
il y a un bouton ok qui apparait 4 fois de suite puis le message
avec toutes les informations nécessaires puis je clique sur OK
plusieurs fois pour sortir
Cela est du à quoi
"
jager57
Messages postés27Date d'inscriptionmardi 19 décembre 2000StatutMembreDernière intervention22 août 2008 20 août 2008 à 10:55
excuse moi de te déranger à nouveau
mais jŽai constaté un autre problème
quand un numéro de schéma a deux références (sur deux lignes)
il me trouve une seule référence
jager57
Messages postés27Date d'inscriptionmardi 19 décembre 2000StatutMembreDernière intervention22 août 2008 20 août 2008 à 11:52
ok mais ton adresse mail nŽ ai pas la bonne
ex pour le schéma 18-4-94
msg box elle faudrait quŽelle affiche :
le schéma 18-4-94 sŽappelle chat
le schéma 18-4-94 a un numéro de référence E 5014 et à plusieurs modèles (elle affiche cela)
(il manque cela) le schéma 18-4-94 a un numéro de référence E 5011 et à plusieurs modèles
jrivet
Messages postés7393Date d'inscriptionmercredi 23 avril 2003StatutMembreDernière intervention 6 avril 201260 20 août 2008 à 15:25
Re,
Pour l'instant j'arrive à cela.Est ce sur la bonne voix? Peux tu l'adapter seul? comprends tu un peu l'idée?
Sub Obtenirlaréférence2()
Dim msg As String
Dim Reponse As VbMsgBoxResult
Dim articledereference As String
Dim croix As String
Dim modell As String
Dim croix1 As String
On Error GoTo Erreur
Reessayer:
Application.ScreenUpdating = False
Sheets("Tabelle1").Activate
Numpiece = InputBox("le nom de schéma : ")
If Numpiece = vbNullString Then GoTo Erreur
Sheets("Tabelle1").Range("B3").Select
msg = vbNullString
Do
ActiveCell.Offset(1, 0).Select
nomdeschematest = WorksheetFunction.VLookup(Numpiece, Range("tableau"), 8, False) If nomdeschematest vbNullString Then msg "le schéma est inconnu"
If ActiveCell.Value = Numpiece Then
Nomdeschema = ActiveCell.Offset(0, 7).Value
msg = msg & "le schéma " & Numpiece & " s'apelle " & Nomdeschema
croix = ActiveCell.Offset(0, 1).Value
Select Case croix
Case "N": msg = msg & vbCrLf & "le schéma n'a aucun numéro d'articles"
Case vbNullString: msg = msg & vbCrLf & "mais le schéma n'existe plus"
Case "J", "-": articledereference = ActiveCell.Offset(0, 4).Value
msg = msg & vbCrLf & "le schéma " & Numpiece & " a un numéro d'articles " & articledereference
End Select
croix1 = ActiveCell.Offset(0, 5).Value
Select Case croix1
Case vbNullString: msg = msg & vbCrLf & " et à plusieurs modèles "
Case "N": msg = msg & vbCrLf & vbNullString
Case "U": msg = msg & vbCrLf & vbNullString
Case "X": msg = msg & vbCrLf & " et à un modèle " & modell
End Select
End If
Loop While ActiveCell.Value <> Empty
Call MsgBox(msg, vbOKOnly)
Exit Sub
Erreur: If Nomdeschema vbNullString Or Numpiece vbNullString Then msg = " le schéma est inconnu.réessayer? "
Reponse = MsgBox(msg, vbYesNo)
If Reponse = vbYes Then GoTo Reessayer
'If Reponse = vbNo Then Exit Sub '=> inutile aussi puisque il sortira si reponse <> vbyes
'If Reponse = vbCancel Then Exit Sub 'NB=> Si tu met vbYesNo => Reponse ne vaudra JAMAIS VbCancel donc inutile