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 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193
| Sub creationFacture()
Dim derniereLigne As Integer
Dim premiereLigne As Integer
Dim docNumber As Integer
Dim customerNumber As Integer
Dim numClient As Integer
Dim dateDoc As Date
Dim consultantFirstnameName As String
Dim consultantName As String
Dim period As String
Dim customerName As String
Dim customerAdress As String
Dim feuilleName() As String
Dim numFactCustomer() As String
Dim cpt As Integer
Dim i As Integer
Dim j As Integer
Dim check As Integer
Dim check2 As Integer
Dim derLigne As Integer
Dim typeInvoice As String
Dim nomFichier As String
Dim sh As Worksheet
Dim numFacture As Integer
'on désactive le rafraichissement de l'écran
Application.ScreenUpdating = False
'n° de la dernière ligne non vide de la colonne A
derniereLigne = ThisWorkbook.Sheets("INVOICE LIST").Range("A" & Rows.Count).End(xlUp).Row
'n° de la premiere ligne non vide de la colonne A
premiereLigne = 14
'récupération des infos feuilles Invoice
docNumber = ThisWorkbook.Sheets("FACTURE FR").Range("I12").Value 'doc
customerNumber = ThisWorkbook.Sheets("FACTURE FR").Range("I12").Value 'customer
dateDoc = ThisWorkbook.Sheets("FACTURE FR").Range("K12").Value 'date
customerAdress = ThisWorkbook.Sheets("FACTURE FR").Range("C17").Value 'Adresse Société
'compteur a zero
cpt = 1
'initialiser tableau
ReDim Preserve feuilleName(1)
ReDim Preserve numFactCustomer(1)
'blindage : on recupere le nom des feuilles et on les stockes pour eviter bug (recreer une feuille alors qu'elle existe)
For Each sh In ThisWorkbook.Sheets
numFactCustomer(cpt) = sh.Name
cpt = cpt + 1
ReDim Preserve numFactCustomer(cpt + 1)
Next
're initialisation compteur
cpt = 1
'effacer feuilles existantes si differents de INVOICE LIST et Invoice et redimensionner tableau
'Boucle pour parcourir la facture en Feuille 1 et copier les infos dans la feuille de facture
For i = premiereLigne To derniereLigne
'si EX egal customerNumber et date ok
If ThisWorkbook.Sheets("INVOICE LIST").Cells(i, 5).Value = customerNumber And dateDoc <= ThisWorkbook.Sheets("INVOICE LIST").Cells(i, 2).Value Then
'recuperation numéro de la facture actuelle
docNumber = ThisWorkbook.Sheets("INVOICE LIST").Cells(i, 1).Value
'recuperation nom du client
customerName = ThisWorkbook.Sheets("INVOICE LIST").Cells(i, 3).Value
'concatenation pour nom de fichier
nomFichier = docNumber & " - " & customerName
'recuperation type of invoice
typeInvoice = ThisWorkbook.Sheets("INVOICE LIST").Cells(i, 20).Value
'si nom de fichier existant, supprimer
check2 = checkFeuillet(nomFichier, numFactCustomer())
Application.DisplayAlerts = False
If check2 = 1 Then
'supprimer feuille
ThisWorkbook.Sheets(nomFichier).Delete
'retirer le nom de la liste
If UBound(numFactCustomer) > 0 Then
For j = 0 To UBound(numFactCustomer) - 1
If numFactCustomer(j) = nomFichier Then
numFactCustomer(j) = "VIDE"
End If
Next
End If
End If
Application.DisplayAlerts = True
'Si feuille deja existante au nom du consultant
check = checkFeuillet(nomFichier, feuilleName())
If check = 1 Then
'recuperer derniere ligne remplie
derLigne = ThisWorkbook.Sheets(nomFichier).Range("E57").End(xlUp).Row
'copier info tableau de feuille de reference dans feuillet consultant a la derniere ligne
Call remplirFacture(i, nomFichier, derLigne, typeInvoice, consultantName)
Else
'Sinon
'ajouter nom consultant dans tableau
feuilleName(cpt) = nomFichier
cpt = cpt + 1
ReDim Preserve feuilleName(cpt + 1)
'copier mise en page feuillet de reference dans nouveau feuillet
ThisWorkbook.Sheets("FACTURE FR").Select
ThisWorkbook.Sheets("FACTURE FR").Copy After:=ThisWorkbook.Sheets("FACTURE FR")
ActiveSheet.Name = nomFichier
'recuperer derniere ligne remplie
derLigne = ThisWorkbook.Sheets(nomFichier).Range("E57").End(xlUp).Row
'copier info tableau de feuille de reference dans feuillet consultant a la derniere ligne
Call remplirFacture(i, nomFichier, derLigne, typeInvoice, consultantName)
End If
'Renommer feuilles
'XXX A CODER XXX
'Envoyer dans mail predefini
'XXX A CODER XXX
End If
Next
'on selectionne la page Invoice
ThisWorkbook.Sheets("INVOICE LIST").Select
'on reactive le rafraichissement de l'écran
Application.ScreenUpdating = True
End Sub
Function checkFeuillet(nomFichier As String, feuilleName() As String) As Integer
'declaration ressources
Dim check As Integer
Dim j As Integer
Dim longTab As Integer
check = 0 'on fixe de base a 0
longTab = UBound(feuilleName) 'recuperation taille tableau
'boucle sur tableau pour savoir si il existe deja une feuille au nom du consultant
If longTab > 1 Then
For j = 0 To longTab - 1
If feuilleName(j) = nomFichier Then
check = 1
End If
Next
End If
'valeur de retour
checkFeuillet = check
End Function
Sub remplirFacture(i As Integer, nomFichier As String, derLigne As Integer, typeInvoice As String, consultantName As String)
'copier info tableau de feuille de reference dans feuillet consultant a la derniere ligne
'nom consultant
ThisWorkbook.Sheets(nomFichier).Cells(derLigne + 2, 5).Value = consultantName
'For
ThisWorkbook.Sheets(nomFichier).Cells(derLigne + 2, 7).Value = ThisWorkbook.Sheets("INVOICE LIST").Cells(i, 9).Value
'quantity
ThisWorkbook.Sheets(nomFichier).Cells(derLigne + 2, 10).Value = ThisWorkbook.Sheets("INVOICE LIST").Cells(i, 11).Value
'unit price
ThisWorkbook.Sheets(nomFichier).Cells(derLigne + 2, 9).Value = ThisWorkbook.Sheets("INVOICE LIST").Cells(i, 10).Value
'total
ThisWorkbook.Sheets(nomFichier).Cells(derLigne + 2, 11).Value = ThisWorkbook.Sheets("INVOICE LIST").Cells(i, 13).Value
'currency
ThisWorkbook.Sheets(nomFichier).Cells(derLigne + 2, 12).Value = ThisWorkbook.Sheets("INVOICE LIST").Cells(i, 12).Value
'type
Select Case typeInvoice
Case "SERVICES"
ThisWorkbook.Sheets(nomFichier).Cells(derLigne + 2, 3).Value = "Honoraires de "
Case "EXPENSES REIMB."
ThisWorkbook.Sheets(nomFichier).Cells(derLigne + 2, 3).Value = "Remboursements de frais de "
Case "HSUPP"
ThisWorkbook.Sheets(nomFichier).Cells(derLigne + 2, 3).Value = "Temps supplémentaire de "
Case "ON CALL"
ThisWorkbook.Sheets(nomFichier).Cells(derLigne + 2, 3).Value = "Permanence téléphonique de "
End Select
'supprimer bouton feuille consultant
ThisWorkbook.Sheets(nomFichier).Buttons.Delete
End Sub |
Partager