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
| Sub Demo()
Const D = ",""", F = """"
Dim Q$, R&, S$, SC, SL, SP, V, VA
Q = Me.Path & "\export.csv"
If Dir(Q) = "" Then Beep: Exit Sub
Application.ScreenUpdating = False
With Workbooks.Open(Q, Local:=True).Worksheets(1)
Me.Worksheets(1).[C2:C12].Value = Application.Transpose(Application.Index(.[A1:O2], 2, [{1,3,6,8,9,10,11,12,13,14,15}]))
Q = .[G2].Value
.Parent.Close False
End With
With Me.Worksheets(1)
.[B19].CurrentRegion.Offset(1).ClearContents
ReDim VA(1, 0)
SP = Split(Q, "Finalisation de votre projet :")
If UBound(SP) > 0 Then
Q = SP(0)
For Each V In Split(SP(1), vbCrLf)
If V Like " - Question 1[1-2] (*" Then
VA(R, 0) = Split(Split(V, "(")(1), ")")(0)
R = R + 1
If R = 2 Then Exit For
End If
Next
End If
.[C16:C17].Value = VA
SP = Split(Q, "Description de ")
For R = 1 To UBound(SP)
SL = Split(SP(R), vbCrLf)
S = IIf(S > "", S & ";", "") & R & D & Split(SL(0), ":")(0) & F
For Each V In SL
If V Like " - ?uestion *" Then
SC = Split(V, "(")
If UBound(SC) > 0 Then
S = S & D & Split(SC(1), ")")(0) & F
Else
SC = Split(V, ": ")
If UBound(SC) > 0 Then S = S & D & SC(1) & F
End If
End If
Next
Next
VA = Evaluate("{" & S & "}")
If IsError(VA) Then Beep Else .[B20].Resize(UBound(VA), UBound(VA, 2)).Value = VA
End With
Application.ScreenUpdating = True
End Sub |
Partager