TheLio
XLDnaute Accro
Salut le forum,
Dans le cadre de mon travail, j'ai hérité d'un classeur assez bien ficelé avec ces lignes de codes:
Je ne comprend malheureusement pas la moitié de ce code.
Est-ce qu'une âme charitable pourrait me le commenter ?
Je sais que ce n'est pas très fun à faire, mais moi j'en suis malheureusement inccapable.
D'avance merci
TheLio
Dans le cadre de mon travail, j'ai hérité d'un classeur assez bien ficelé avec ces lignes de codes:
Code:
Option Explicit
' Mes excuses les plus sincères à celui ou celle qui devra reprendre ce code...
' En effet, il n'y a quasiment rien de commenté. La prog n'est pas du tout
' orientée objet (le langage ne s'y prête pas, note).
' Un conseil quand meme, bien regarder les références aux cellules. Si ça ne
' fonctionne plus, c'est peut-être à cause de ça (une ligne de rajoutée, ce
' genre de truc...).
' Voilà, je n'ai plus qu'une chose à dire : bonne chance :)
Dim c As Workbook
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row <> 39 And Target.Column <> 5 Then
set_nomOnglet prop_jour, "fr"
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo fermeFichier
If Target.Row = 39 And Target.Column = 4 Then
If (MsgBox("Tu vas envoyer les commandes par mail, au format électronique, à : " + vbCrLf + vbCrLf + vbTab + [E39] + vbCrLf + vbCrLf + "Si tu veux pas, clique sur 'NON'. Si c'est bon, clique sur 'OUI'." + vbCrLf + "Si une fenêtre apparaît ensuite, et qu'elle parle de possibilité de virus, clique de nouveau sur 'OUI'. A+", vbYesNo, "Envoi de mail") = vbYes) Then
If envoiMail("Page de garde") Then
MsgBox ("Mail envoyé à " + [E39] + ".")
End If
End If
End If
Exit Sub
fermeFichier:
c.Saved = True
c.Close
MsgBox ("Le mail n'a pas pu partir, l'application s'est arrêtée. Sorry...")
Exit Sub
End Sub
Private Function envoiMail(ByVal garde As String)
Dim f As Worksheet
Dim w As Window
Dim txt As String, objMsg As String
Dim lng As Integer, col As Integer, nbf As Integer
Dim ok As Boolean
lng = 10
col = 2
ok = True
nbf = 0
txt = Cells(lng, col)
Set w = Windows(1)
ThisWorkbook.Sheets(garde).Copy
Set c = Workbooks.Item(Workbooks.Count)
For Each f In w.SelectedSheets
If f.Name <> garde Then
f.Copy after:=Workbooks(c.Name).Sheets(garde)
End If
nbf = nbf + 1
Next
If nbf > 8 Then
If MsgBox("T'as sélectionné beaucoup onglets. C'est peut-être voulu, mais peut-être pas. Envoyer quand même le mail ?", vbYesNo) = vbNo Then
ok = False
End If
End If
If ok Then
SupprimeToutCodeEtFormulaire c.Name
For Each f In Workbooks(c.Name).Application.Worksheets
If f.Name = garde Then
f.Cells(lng, col).Value = txt
End If
f.Protect Password:="bluKwerhT93pOO20093"
Next
objMsg = [B45] & " --- semaine " & [F8]
Workbooks(c.Name).SendMail Split([E39], ","), objMsg, True
End If
c.Saved = True
c.Close
If ok Then
envoiMail = True
Else
envoiMail = False
End If
End Function
Private Sub SupprimeToutCodeEtFormulaire(NomClasseur As String)
Dim VBComp As Object
Dim VBComps As Object
Set VBComps = Workbooks(NomClasseur).VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next VBComp
End SubJe ne comprend malheureusement pas la moitié de ce code.
Est-ce qu'une âme charitable pourrait me le commenter ?
Je sais que ce n'est pas très fun à faire, mais moi j'en suis malheureusement inccapable.
D'avance merci
TheLio
