petite aide sur ce code please

[zesuila]

Bonjour le forum

Voilà, j'ai un soucis sur ce code :
Après avoir appuyé sur le joli bouton ce code se lance mais
1- j'ai le message voulez vous archivez ce bon qui apparait une 1ere fois (c'est ce que je voulais ), je ds donc OK
et là ce message (le salopiaud) revient une seconde fois :angry:
Pour lui faire plaisir je refais OK ! Mais là, il revient de nouveau (il me cherche ce message ! :evil: )

2- En plus, quand je lui dis non , je ne veux pas archiver ce p... de bon, ce message disparait et ..... réapparait :evil: :evil:
et à sa 3e réapparition, il..... m'archive quand même le bon !!!!! :woohoo: :woohoo: :woohoo:

Bref c'est un message récalcitrant !
Donc pour lui clouer le bec à ce message, j'attends votre aide
(L'union fait la force!)
Ps: j'ai l'impression que c'est mes if, End if, else qui fout le bord.., (je parle doucement pour pas que le message entende, il est filou vous savez !)


Voici le code :
Private Sub CommandButton1_Click()
Dim WsSource As Worksheet
Dim WsCible As Worksheet
Dim MaLigneSource As Range
Dim MaligneCible As Range
Dim derlgn As Integer

If TextBox13.Value = 'BL' Then
Unload LIVRAISON
Worksheets('BL').Activate
ActiveWindow.SelectedSheets.PrintPreview
End If

If MsgBox('ARCHIVER LE BON ?', vbYesNo) = vbYes Then
Set WsSource = Worksheets('F1')
Set WsCible = Worksheets('F3')
Set MaLigneSource = WsSource.Range('A4:N4')
With WsCible
derlgn = .Range('A5000').End(xlUp).Row + 1
Set MaligneCible = .Range(.Cells(derlgn, 1), .Cells(derlgn, 14))
MaligneCible = MaLigneSource.Value
End With

Else
End If

If TextBox13.Value = 'OR' Then
Unload LIVRAISON
Worksheets('OR').Activate
ActiveWindow.SelectedSheets.PrintPreview
End If
If MsgBox('ARCHIVER LE BON ?', vbYesNo) = vbYes Then
Set WsSource = Worksheets('F1')
Set WsCible = Worksheets('F3')
Set MaLigneSource = WsSource.Range('A4:N4')

With WsCible
derlgn = .Range('A5000').End(xlUp).Row + 1
Set MaligneCible = .Range(.Cells(derlgn, 1), .Cells(derlgn, 14))
MaligneCible = MaLigneSource.Value
End With

Else
End If
If TextBox13.Value = 'BD' Then
Unload LIVRAISON
Worksheets('BD').Activate
'ActiveWindow.WindowState = xlMinimized
ActiveWindow.SelectedSheets.PrintPreview
End If
If MsgBox('ARCHIVER LE BON ?', vbYesNo) = vbYes Then
Set WsSource = Worksheets('F1')
Set WsCible = Worksheets('F3')
Set MaLigneSource = WsSource.Range('A4:N4')

With WsCible
derlgn = .Range('A5000').End(xlUp).Row + 1
Set MaligneCible = .Range(.Cells(derlgn, 1), .Cells(derlgn, 14))
MaligneCible = MaLigneSource.Value
End With
End If



Dim Chr As String
Chr = Range('e3') 'Feuille Essai et cellule C1
'ChDrive 'E' 'si C n'est pas le disque par défaut
ChDir 'C:\\Documents and Settings\\indyol\\Mes documents\\INDYOL\\travail\\archives\\'
ActiveSheet.Copy
Unload menu
With Application
.MaxChange = 0.001
.CalculateBeforeSave = False
End With
With ActiveWorkbook
.UpdateRemoteReferences = False
.PrecisionAsDisplayed = False
.SaveLinkValues = False
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.SaveAs Filename:=(Chr)
ActiveWorkbook.Close False

ACTION.Show
retour.Show

End Sub


Que la force soit avec vous! B)
Et Merci pour votre aide

 

[PascalXLD]

Bonjour

Pas trop le temps de regarder le code mais change aux endroits indiqués

Private Sub CommandButton1_Click()
Dim WsSource As Worksheet
Dim WsCible As Worksheet
Dim MaLigneSource As Range
Dim MaligneCible As Range
Dim derlgn As Integer

If TextBox13.Value = 'BL' Then
Unload LIVRAISON
Worksheets('BL').Activate
ActiveWindow.SelectedSheets.PrintPreview
'Enleve ici le endif

If MsgBox('ARCHIVER LE BON ?', vbYesNo) = vbYes Then
Set WsSource = Worksheets('F1')
Set WsCible = Worksheets('F3')
Set MaLigneSource = WsSource.Range('A4:N4')
With WsCible
derlgn = .Range('A5000').End(xlUp).Row + 1
Set MaligneCible = .Range(.Cells(derlgn, 1), .Cells(derlgn, 14))
MaligneCible = MaLigneSource.Value
End With
End if 'OUBLI
ElseIf TextBox13.Value = 'OR' Then 'MODIFIES ICI LES 3LIGNES
Unload LIVRAISON
Worksheets('OR').Activate
ActiveWindow.SelectedSheets.PrintPreview
'Enleve ici le endif
If MsgBox('ARCHIVER LE BON ?', vbYesNo) = vbYes Then
Set WsSource = Worksheets('F1')
Set WsCible = Worksheets('F3')
Set MaLigneSource = WsSource.Range('A4:N4')

With WsCible
derlgn = .Range('A5000').End(xlUp).Row + 1
Set MaligneCible = .Range(.Cells(derlgn, 1), .Cells(derlgn, 14))
MaligneCible = MaLigneSource.Value
End With
End if 'OUBLI
ElseIf TextBox13.Value = 'BD' Then 'MODIFIES ICI LES 3LIGNES
Unload LIVRAISON
Worksheets('BD').Activate
'ActiveWindow.WindowState = xlMinimized
'Enleve ici le endif
If MsgBox('ARCHIVER LE BON ?', vbYesNo) = vbYes Then
Set WsSource = Worksheets('F1')
Set WsCible = Worksheets('F3')
Set MaLigneSource = WsSource.Range('A4:N4')

With WsCible
derlgn = .Range('A5000').End(xlUp).Row + 1
Set MaligneCible = .Range(.Cells(derlgn, 1), .Cells(derlgn, 14))
MaligneCible = MaLigneSource.Value
End With
End If

End If 'AJOUTE ICI UN END IF

Dim Chr As String
Chr = Range('e3') 'Feuille Essai et cellule C1
'ChDrive 'E' 'si C n'est pas le disque par défaut
ChDir 'Cocuments and SettingsindyolMes documentsINDYOLtravailarchives'
ActiveSheet.Copy
Unload menu
With Application
.MaxChange = 0.001
.CalculateBeforeSave = False
End With
With ActiveWorkbook
.UpdateRemoteReferences = False
.PrecisionAsDisplayed = False
.SaveLinkValues = False
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.SaveAs Filename:=(Chr)
ActiveWorkbook.Close False

ACTION.Show
retour.Show

End Sub

Tu essaies et tu dis

Bon courage

Message édité par: Pascal76, à: 29/09/2005 20:27

Message édité par: Pascal76, à: 29/09/2005 20:46

 

[bebere]

bonsoir Zesuila

de l'aide vba

Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = 'Souhaitez-vous continuer?' ' Définit le message.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Définit les boutons.
Title = 'Démonstration de MsgBox ' ' Définit le titre.
Help = 'DEMO.HLP' ' Définit le fichier d'aide.
Ctxt = 1000 ' Définit le contexte de
' la rubrique.
' Affiche le message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' L'utilisateur a choisi Oui.
MyString = 'Oui' ' Effectue une action.
Else ' L'utilisateur a choisi Non.
MyString = 'Non' ' Effectue une action.
End If

donc ta ligne If MsgBox('ARCHIVER LE BON ?', vbYesNo) = vbYes Then
devient
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' L'utilisateur a choisi Oui.
Set WsSource = Worksheets('F1')
Set WsCible = Worksheets('F3')
Set MaLigneSource = WsSource.Range('A4:N4')
With WsCible
derlgn = .Range('A5000').End(xlUp).Row + 1
Set MaligneCible = .Range(.Cells(derlgn, 1), .Cells(derlgn, 14))
MaligneCible = MaLigneSource.Value
End With
Else ' L'utilisateur a choisi Non.
exit sub ' MyString = 'Non' ' Effectue une action.
End If

à bientôt

 

[PascalXLD]

re

Je pense que tu peux simplifier ainsi si je ne me suis pas trompé

Private Sub CommandButton1_Click()
Dim WsSource As Worksheet
Dim WsCible As Worksheet
Dim MaLigneSource As Range
Dim MaligneCible As Range
Dim derlgn As Integer

If TextBox13.Value = 'BL' Then
Unload LIVRAISON
Worksheets('BL').Activate
ActiveWindow.SelectedSheets.PrintPreview

ElseIf TextBox13.Value = 'OR' Then
Unload LIVRAISON
Worksheets('OR').Activate
ActiveWindow.SelectedSheets.PrintPreview

ElseIf TextBox13.Value = 'BD' Then
Unload LIVRAISON
Worksheets('BD').Activate
End If

If MsgBox('ARCHIVER LE BON ?', vbYesNo) = vbYes Then
Set WsSource = Worksheets('F1')
Set WsCible = Worksheets('F3')
Set MaLigneSource = WsSource.Range('A4:N4')
With WsCible
derlgn = .Range('A5000').End(xlUp).Row + 1
Set MaligneCible = .Range(.Cells(derlgn, 1), .Cells(derlgn, 14))
MaligneCible = MaLigneSource.Value
End With
END IF 'ICI

Dim Chr As String
Chr = Range('e3') 'Feuille Essai et cellule C1
'ChDrive 'E' 'si C n'est pas le disque par défaut
ChDir 'Cocuments and SettingsindyolMes documentsINDYOLtravailarchives'
ActiveSheet.Copy
Unload Menu
With Application
.MaxChange = 0.001
.CalculateBeforeSave = False
End With
With ActiveWorkbook
.UpdateRemoteReferences = False
.PrecisionAsDisplayed = False
.SaveLinkValues = False
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.SaveAs Filename:=(Chr)
ActiveWorkbook.Close False

ACTION.Show
retour.Show

End Sub

Message édité par: Pascal76, à: 29/09/2005 20:43

 

[zesuila]

Bonjour Pascal76, bebere

Pascal76, que veux tu dire lorsque tu écris ' modifie ici les 3 lignes'?

Bébere, je vais aussi regarder ton code, mais tranquillement car il me semble un peu plus compliqué pour moi. Mais je vais m'y interéssé qd même.
Bonne soirée.
Je réponds demain

 

[PascalXLD]

Re

ces 3 lignes là

Else
End If

If TextBox13.Value = 'OR' Then

deviennent 1 seule ligne

ElseIf TextBox13.Value = 'OR'

Bonne soirée

 

[zesuila]

J'ai essayé ton code, il me dit 'Bloc If sans end if ( pourtant j'ai corrigé mon code (en faisant entrée après else et cela sur les 2 lignes)

 

[PascalXLD]

re

OUPS t'as raison

Pour le dernier code que j'ai donné j'ai edité pour remttre le end if manquant

pour le premier j'ai oublié les end if des msgbox
je vais éditer et les rajouter en Orange

 

[zesuila]

désolé de ne pas avoir répondu plus tôt Pascal76
Je n'ai pas le temps d'essayer ce sor, je te réponds demain.
Encore merci

 

[zesuila]

Bonjour Pascal76, Bébere, le forum
Ca Y est !!! Cela fonctionne parfaitement.

Je vais regarder maintenant tranquillement ton code afin de le comprendre.

Encore merci

Bonne journée à vous tous

 

[zesuila]

Bonjour Pascal76, Bébere, le forum
Ca Y est !!! Cela fonctionne parfaitement.

Je vais regarder maintenant tranquillement ton code afin de le comprendre.

Encore merci

Bonne journée à vous tous

 

[bebere]

bonjour Zesuila,Pascal
excusez moi mais hier je me suis planté et mon pc aussi
tout à nouveau en ordre et pour vous deux aussi
à bientôt