1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117
| Option Explicit
Dim MaListe() As Variant, nbarb As Long, varb As Long, nbp As Long, vp As Long, vbi As Long, pptaire As String
Dim proprio() As String, n As Long, l As Long, a As Long, b As Long, estim() As Variant, NomFeuille As String, ValBi As Long
Private Sub UserForm_Initialize()
Dim s As Object
For Each s In ActiveWorkbook.Sheets
If s.Name <> "Parametres" And s.Name <> "Page" Then
Me.LBChoix.AddItem s.Name
End If
Next s
Me.LBChoix.ListIndex = -1
End Sub
Private Sub LBChoix_Change()
Dim i As Long, Sh As Worksheet, n As Long
ReDim MaListe(0)
ReDim proprio(0)
ReDim estim(0)
With Me.LBChoix
nbarb = 0
varb = 0
nbp = 0
vp = 0
vbi = 0
ValBi = 0
pptaire = ""
For i = 0 To .ListCount - 1
If .Selected(i) Then
' Sélection plage de valeur
MaListe(UBound(MaListe)) = fmChoixFeuille.LBChoix.List(i) & "!R8C21:R16C42"
ReDim Preserve MaListe(UBound(MaListe) + 1)
' Sélection des proprio
proprio(UBound(proprio)) = Sheets(fmChoixFeuille.LBChoix.List(i)).Range("Z2").Value
ReDim Preserve proprio(UBound(proprio) + 1)
' Copie des estimations de chaque feuille
estim(UBound(estim)) = Sheets(fmChoixFeuille.LBChoix.List(i)).Range("AQ25").Value
ReDim Preserve estim(UBound(estim) + 1)
With Sheets(fmChoixFeuille.LBChoix.List(i))
nbarb = nbarb + .Range("Y17").Value
varb = varb + .Range("AG17").Value
nbp = nbp + .Range("Y18").Value
vp = vp + .Range("AG18").Value
vbi = vbi + .Range("AM17").Value
ValBi = ValBi + .Range("AQ23").Value
pptaire = Trim(pptaire) & ";" & .Range("Z2").Value
End With
End If
Next i
End With
End Sub
Private Sub CmdValid_Click()
Application.DisplayAlerts = False
If UBound(MaListe) > 0 Then
ReDim Preserve MaListe(UBound(MaListe) - 1)
End If
If UBound(proprio) > 0 Then
ReDim Preserve proprio(UBound(proprio) - 1)
End If
If UBound(estim) > 0 Then
ReDim Preserve estim(UBound(estim) - 1)
End If
If ActiveWorkbook.ActiveSheet.Name = "Page" Then
MsgBox "Attention! Il faut d'abord sélectionner" & Chr(10) & "la feuille que l'on veut copier!", vbExclamation + vbOKOnly, "Sélection de la Feuille :"
Else
ActiveWorkbook.ActiveSheet.Copy Before:=Sheets("Page")
ActiveWorkbook.ActiveSheet.Name = "RECAPITULATIF"
With Sheets("RECAPITULATIF")
.Range("U8:AP16").ClearContents
.Range("B1:Q216").ClearContents
' Consolidation des données
.Range("U8:AP16").Consolidate Sources:=MaListe(), Function:=xlSum, TopRow:=True, LeftColumn:=True, CreateLinks:=False
' Consolidation de la valeur du Bois d'industrie
.Range("AQ23").Value = ValBi
' On colle les proprio
For n = 0 To UBound(proprio)
l = 30 + n
.Range("AN" & l).Value = proprio(n)
Next n
' On colle les estimations de chaque proprio
For b = 0 To UBound(estim)
l = 30 + b
.Range("AQ" & l).Value = estim(b)
Next b
' Calcul du pourcentage de chacun
a = 30
While .Range("AQ" & a).Value <> ""
.Range("AR" & a).Value = .Range("AQ" & a).Value / .Range("AQ25").Value
a = a + 1
Wend
' Calcul nb et vol de chaque catégorie (arbre, perche et bi)
.Range("Y17").Value = nbarb
.Range("AG17").Value = varb
.Range("Y18").Value = nbp
.Range("AG18").Value = vp
.Range("AM17").Value = vbi
.Range("Z2").Value = Right(Trim(pptaire), Len(Trim(pptaire)) - 1)
End With
NomFeuille = InputBox("Nom du récapitulatif : ", "Nommer le Récap")
Sheets("RECAPITULATIF").Name = "RECAP " & NomFeuille
End If
Application.DisplayAlerts = True
Unload Me
End Sub
Private Sub CmdQuit_Click()
Unload Me
End Sub |
Partager