Raccourcir un code

Le 16/10/2017 à 22:51

Bonsoir, ou re pour ceux qui on déjà lu mes autres questions

Etant débutant en vba, j'adapte à mon projet les codes que je trouve, mais pas de manières toujours très intelligentes à mon avis.

Et j'aimerais y remédier.

Vous pourrez voir dans le code qui suit (N'ayez pas peur ) que je me répète. Cela fonctionne mais c'est assez lourd.

Je voudrais donc modifier en déclarant une variable appelée Mag que je pourrais rappelé pour limiter le nombre de ligne :

Dim Mag As String

Mag = Sheets ("Prod").Range ("B68"). Value

Puis Remplacer mon gros premier bloc de If par une seule ligne :

If Sheets("Prod").Range("B68").Value = Mag Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\Mag.gif")

Bien sur ça ne fonctionne pas, cela aurait été trop simple

Là où ça bloque , c'est le ColAttach.Add("O:\KiKiFé\Signatures\Mag.gif")

Puis le deuxieme bloc de if par une seule ligne :

If Sheets("Prod").Range("B68").Value = Mag Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _

" <br><br><IMG src=cid:Mag.gif></BODY>"

Bien sur ça ne fonctionne pas, cela aurait été trop simple

Là où ça bloque pour commencer , c'est le ColAttach.Add("O:\KiKiFé\Signatures\Mag.gif")

Quelle est donc mon erreur?

Voici mon code original 

Private Sub CommandButton2_Click()

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim objOL As Object
    Dim oAttach As Object
    Dim ColAttach As Object

    Set rng = Nothing
    On Error Resume Next

    Set rng = Sheets("CourrierAppro").Range("A1:G29").SpecialCells(xlCellTypeVisible)

    On Error GoTo 0

    If rng Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    Set ColAttach = OutMail.Attachments

        If Sheets("Prod").Range("B68").Value = "V1" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V1.gif")
        If Sheets("Prod").Range("B68").Value = "V2" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V2.gif")
        If Sheets("Prod").Range("B68").Value = "V3" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V3.gif")
        If Sheets("Prod").Range("B68").Value = "V4" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V4.gif")
        If Sheets("Prod").Range("B68").Value = "V5" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V5.gif")
        If Sheets("Prod").Range("B68").Value = "V6" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V6.gif")
        If Sheets("Prod").Range("B68").Value = "V7" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V7.gif")
        If Sheets("Prod").Range("B68").Value = "V8" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V8.gif")
        If Sheets("Prod").Range("B68").Value = "V9" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V9.gif")
        If Sheets("Prod").Range("B68").Value = "V10" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V10.gif")
        If Sheets("Prod").Range("B68").Value = "V11" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V11.gif")
        If Sheets("Prod").Range("B68").Value = "V12" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V12.gif")
        If Sheets("Prod").Range("B68").Value = "V13" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V13.gif")
        If Sheets("Prod").Range("B68").Value = "V14" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V14.gif")
        If Sheets("Prod").Range("B68").Value = "V15" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V15.gif")
        If Sheets("Prod").Range("B68").Value = "V16" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V16.gif")
        If Sheets("Prod").Range("B68").Value = "V17" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V17.gif")
        If Sheets("Prod").Range("B68").Value = "V18" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V18.gif")
        If Sheets("Prod").Range("B68").Value = "V19" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V19.gif")
        If Sheets("Prod").Range("B68").Value = "V20" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V20.gif")
        If Sheets("Prod").Range("B68").Value = "V21" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V21.gif")
        If Sheets("Prod").Range("B68").Value = "V22" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V22.gif")
        If Sheets("Prod").Range("B68").Value = "V23" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V23.gif")
        If Sheets("Prod").Range("B68").Value = "V24" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V24.gif")
        If Sheets("Prod").Range("B68").Value = "V25" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V25.gif")
        If Sheets("Prod").Range("B68").Value = "V26" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V26.gif")
        If Sheets("Prod").Range("B68").Value = "V27" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V27.gif")
        If Sheets("Prod").Range("B68").Value = "V28" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V28.gif")
        If Sheets("Prod").Range("B68").Value = "V29" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V29.gif")
        If Sheets("Prod").Range("B68").Value = "V30" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V30.gif")

    On Error Resume Next
    With OutMail
        .To = Sheets("Prod").Range("B73").Value & Sheets("Prod").Range("B74").Value & Sheets("Prod").Range("B75").Value & Sheets("Prod").Range("B76").Value
        .CC = ""
        .BCC = ""
        .Subject = "Demande d'étiquettes"

        If Sheets("Prod").Range("B68").Value = "V1" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V1.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V2" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V2.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V3" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V3.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V4" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V4.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V5" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V5.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V6" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V6.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V7" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V7.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V8" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V8.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V9" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V9.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V10" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V10.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V11" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V11.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V12" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V12.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V13" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V13.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V14" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V14.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V15" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V15.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V16" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V16.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V17" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V17.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V18" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V18.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V19" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V19.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V20" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V20.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V21" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V21.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V22" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V22.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V23" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V23.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V24" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V24.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V25" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V25.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V26" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V26.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V27" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V27.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V28" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V28.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V29" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V29.gif></BODY>"   'Nom de l'image sans chemin

        If Sheets("Prod").Range("B68").Value = "V30" Then .HTMLBody = RangetoHTML(rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
        " <br><br><IMG src=cid:V30.gif></BODY>"   'Nom de l'image sans chemin

        .Display
    End With
    On Error GoTo 0

    With Sheets("CourrierAppro").Range("B7:F26").ClearContents
    End With

    With Sheets("Prod").Range("B73:B76").ClearContents
    End With

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub
Le 16/10/2017 à 23:03

bonsoir,

voici comment il faut écrire ces 2 instructions

If Sheets("Prod").Range("B68").Value = Mag Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\" & Mag & ".gif")

If Sheets("Prod").Range("B68").Value = Mag Then .HTMLBody = RangetoHTML(Rng) & "<BODY><FONT face=Arial color=#000080 size=2></FONT>" & _
" <br><br><IMG src=cid:" & Mag & ".gif></BODY>"
Le 16/10/2017 à 23:08

Bonsoir,

un essai pour essayer d'avancer ...

Dans un STRING entre guillemet, pour intégrer une variable VBA il faut la sortir du STRING en fermant les guillemet avant et après la variable puis en concaténant le tout, ce qui peut donner ceci :

If Sheets("Prod").Range("B68").Value = "V1" Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\V1.gif")

remplacer par :

If Sheets("Prod").Range("B68").Value = Mag Then Set oAttach = ColAttach.Add("O:\KiKiFé\Signatures\" & Mag & ".gif")

@ bientôt

LouReeD

Oups ! pas assez rapide, bonsoir acide !

Le 17/10/2017 à 12:59

Super !!! Sur ces explications, je pense que je vais reprendre tout mon projet pour l'alléger un peu.

Merci à tous les deux

Le 17/10/2017 à 18:43

Merci à vous pour ce plein de "super" !

@ bientôt

LouReeD

Rechercher des sujets similaires à "raccourcir code"