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 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780
| Option Explicit
Private Sub ac1_AfterUpdate()
callcul
End Sub
Private Sub ac2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
callcul
End Sub
Private Sub ac3_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
callcul
End Sub
Private Sub CheckBox1_Click()
If CheckBox1 = True Then listclient.MultiSelect = fmMultiSelectExtended Else listclient.MultiSelect = fmMultiSelectSingle
End Sub
Private Sub CheckBox2_Click()
If CheckBox2 = True Then Feuil17.Cells(fact, 7) = 1 Else Feuil17.Cells(fact, 7) = ""
End Sub
Private Sub client_Click()
If fact = 0 Then Exit Sub
gg = dep.client '.List(client.ListIndex, 1)
End Sub
Private Sub client_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
gg = dep.client.List(client.ListIndex, 1)
If gg = 0 Then Exit Sub
clien.Show
End Sub
Private Sub client_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal XX As Single, ByVal Y As Single)
Dim a
If Button = 2 Then
If fact = 10000 Then Exit Sub
If gg = 0 Then Exit Sub
If nom <> "" Then a = MsgBox(mess(9), vbYesNo): If a = 7 Then Exit Sub
pamodif = False
no = Feuil9.Cells(gg, 1)
civi = Feuil9.Cells(gg, 2)
nom = Feuil9.Cells(gg, 3)
attention = Feuil9.Cells(gg, 4)
adr = Feuil9.Cells(gg, 8)
cp = Feuil9.Cells(gg, 9)
If Feuil9.Cells(gg, 10) = "" Then tel = Feuil9.Cells(gg, 11) Else tel = Feuil9.Cells(gg, 10)
maill = Feuil9.Cells(gg, 13)
pay = Feuil9.Cells(gg, 6)
notva = Feuil9.Cells(gg, 7)
TextBox3 = Feuil9.Cells(gg, 15)
TextBox7 = Feuil9.Cells(gg, 16)
TextBox8 = Feuil9.Cells(gg, 17)
ComboBox10 = Feuil9.Cells(gg, 33)
callcul
End If
End Sub
Private Sub ComboBox10_Change()
Feuil17.Cells(fact, 22) = ComboBox10
End Sub
Private Sub CommandButton1_Click()
Feuil3.Select
Application.Calculation = xlCalculationAutomatic
Feuil11.Range("G9") = "FAUX"
End
End Sub
Private Sub CommandButton10_Click()
nouvo = True
pamodif = False
fact = finf2 + 1: Feuil2.Cells(fact, 14) = Feuil11.Cells(13, 2): callcul: remet: listclient.ListIndex = -1
If Feuil11.Range("g3") = True Then nodev = xintitule(1) Else nodev = ""
If Feuil11.Range("h3") = True Then NOFAC = xintitule(2) Else NOFAC = ""
End Sub
Private Sub CommandButton11_Click()
pamodif = True
If gg = 0 Then Exit Sub
clien.Show
End Sub
Private Sub CommandButton12_Click()
Dim a
If fact = 10000 Then Exit Sub
If gg = 0 Then Exit Sub
If nom <> "" Then a = MsgBox(mess(9), vbYesNo): If a = 7 Then Exit Sub
pamodif = False
no = Feuil9.Cells(gg, 1)
civi = Feuil9.Cells(gg, 2)
nom = Feuil9.Cells(gg, 3)
attention = Feuil9.Cells(gg, 4)
adr = Feuil9.Cells(gg, 8)
cp = Feuil9.Cells(gg, 9)
'tel = Feuil9.Cells(gg, 10)
If Feuil9.Cells(gg, 10) = "" Then tel = Feuil9.Cells(gg, 11) Else tel = Feuil9.Cells(gg, 10)
maill = Feuil9.Cells(gg, 13)
pay = Feuil9.Cells(gg, 6)
notva = Feuil9.Cells(gg, 7)
TextBox3 = Feuil9.Cells(gg, 15)
TextBox7 = Feuil9.Cells(gg, 16)
TextBox8 = Feuil9.Cells(gg, 17)
ComboBox10 = Feuil9.Cells(gg, 33)
callcul
End Sub
Private Sub CommandButton13_Click()
Label87 = CommandButton13.Caption
Feuil11.Range("G9") = "VRAI"
CheckBox2 = True
pamodif = True
gg = finf9 + 1: clien.Show
End Sub
Private Sub CommandButton14_Click()
derfac = fact
UserForm3.Show
If Feuil10.Cells(2, 1) <> "" Then
dep.Hide
bilan.Show
fact = derfac
dep.Show
End If
End Sub
Private Sub CommandButton15_Click()
pamodif = True
UserForm2.Show
End Sub
Private Sub CommandButton2_Click()
If TextBox2 = "" Then NouveauRDV_Calendrier
Dim dTextBox As Date
Dim a, fd As Long, h As Integer
If nouvo = True Then pamodif = False
If fact = 10000 Then a = MsgBox(mess(4), vbYesNo, mess(22))
If a = 6 Then CommandButton10 = True: Exit Sub
If a = 7 Then Exit Sub
If nom = "" Then MsgBox mess(20): Exit Sub
dep.Hide
If nouvo = True Then
If Feuil9.Cells(gg, 21) = "Particulier" Then h = 0 Else h = 1
If dep.deplac = False Then
If Feuil9.Cells(gg, 16) > 0 Then fd = Fix(Feuil9.Cells(gg, 16) * Feuil1.Cells(1, h + 4) * 2): Feuil2.Cells(fact, 41) = "1|1||" & fd & "||" & Feuil11.Cells(14, 2) & "|"
End If
fd = Feuil1.Cells(21, h + 4): Feuil2.Cells(fact, 42) = "21|1||" & fd & "||" & Feuil11.Cells(14, 2) & "|"
If deplac = True Then TextBox8 = "": TextBox7 = ""
Feuil2.Cells(fact, 15) = -1
End If
dTextBox = TimeValue(Me.TextBox4.Text)
Me.TextBox2.Text = Format(dTextBox + TimeValue("1:00"), "hh:mm")
UserForm1.Show
nouvo = False
End Sub
Private Sub CommandButton24_Click()
Dim a
ufCal.Show
If retourdate = "" Then Exit Sub
datedevis = retourdate
If InStr(1, nodev, "-") > 0 Then a = Split(nodev, "-"): nodev = Val(a(1))
If retourdate > "" Then nodev = Year(retourdate) & Format(Month(retourdate), "00") & "-" & Format(nodev, "0000")
End Sub
Private Sub CommandButton25_Click()
Dim a
ufCal.Show
If retourdate = "" Then Exit Sub
datefac = retourdate
If InStr(1, NOFAC, "-") > 0 Then a = Split(NOFAC, "-"): NOFAC = Val(a(1))
If retourdate > "" Then NOFAC = Year(retourdate) & Format(Month(retourdate), "00") & "-" & Format(NOFAC, "0000")
If TextBox10 = "" Then TextBox10 = datefac Else TextBox10 = ""
End Sub
Private Sub CommandButton26_Click()
If fact = 10000 Then Exit Sub
donne
dep.Hide
page1.PrintPreview
dep.Show
Feuil3.Select
End Sub
Private Sub CommandButton27_Click()
If fact = 10000 Then Exit Sub
donne
page1.PrintOut From:=1, To:=retour
End Sub
Private Sub CommandButton28_Click()
If fact = 10000 Then Exit Sub
donne
page2.PrintOut From:=1, To:=retour
End Sub
Private Sub CommandButton29_Click()
If fact = 10000 Then Exit Sub
donne
dep.Hide
page2.PrintPreview
dep.Show
Feuil3.Select
End Sub
Private Sub CommandButton30_Click()
If fact = 10000 Then Exit Sub
donne
page3.PrintOut From:=1, To:=retour
End Sub
Private Sub CommandButton31_Click()
If fact = 10000 Then Exit Sub
donne
dep.Hide
page3.PrintPreview
dep.Show
Feuil3.Select
End Sub
Private Sub CommandButton33_Click()
Dim r As Integer
listclient.Clear: etafac2.ListIndex = -1
If client.ListIndex = -1 Then MsgBox (mess(1)): Exit Sub
condi = Feuil9.Cells(client.ListIndex + 2, 1)
: Y = 0
If Crois = False Then
For r = finf2 To 2 Step -1
If Feuil2.Cells(r, 1) = condi Then
listclient.AddItem Feuil2.Cells(r, 3)
listclient.List(Y, 1) = r
Y = Y + 1
End If
Next
Else
For r = 2 To finf2
If Feuil2.Cells(r, 1) = condi Then
listclient.AddItem Feuil2.Cells(r, 3)
listclient.List(Y, 1) = r
Y = Y + 1
End If
Next
End If
factt.Max = listclient.ListCount
If factt.Max > 0 Then fact = Val((listclient.List(0, 1))) Else fact = 10000
If factt.Max > 0 Then listclient.ListIndex = 0 Else listclient.ListIndex = -1
callcul
remet
End Sub
Private Sub CommandButton35_Click()
If fact = 10000 Then Exit Sub
Dim a
If paiement > "" Then Exit Sub
a = MsgBox(mess(2), vbYesNo)
If a = 7 Then Exit Sub
Feuil2.Rows(fact).Delete
lisfact
End Sub
Private Sub CommandButton36_Click()
callcul
pamodif = True
resum.Show
End Sub
Private Sub CommandButton37_Click()
derfac = fact
UserForm33.Show
If Feuil13.Cells(2, 1) <> "" Then UserForm4.Show
fact = derfac
End Sub
Private Sub CommandButton38_Click()
Application.Dialogs(xlDialogPrinterSetup).Show
End Sub
Private Sub CommandButton39_Click()
ThisWorkbook.Save
End Sub
Private Sub CommandButton4_Click()
If fact = 10000 Then Exit Sub
imprim
dep.Hide
Feuil4.PrintPreview
dep.Show
Feuil3.Select
End Sub
Private Sub CommandButton40_Click()
Dim r As Integer
Feuil9.Range("a1:al" & finf9).Sort Key1:=Feuil9.Range("c1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
dico1
dep.client.Clear
For r = 2 To finf9
dep.client.AddItem Feuil9.Cells(r, 1) & " " & Feuil9.Cells(r, 3) & " (" & Feuil9.Cells(r, 4) & ")"
dep.client.List(r - 2, 1) = r
Next
End Sub
Private Sub CommandButton41_Click()
ufCal.Show
If retourdate <> "" Then TextBox1 = retourdate
End Sub
Private Sub CommandButton43_Click()
Dim a
ufCal.Show
If retourdate = "" Then Exit Sub
TextBox10 = retourdate
End Sub
Private Sub CommandButton42_Click()
TextBox9 = ""
End Sub
Private Sub CommandButton44_Click()
Dim NomFichier As String
Dim TypeDoc As String
Dim AbreTypeDoc As String
Dim Numdoc As String
Dim DateDoc As String
Dim HreDoc As String
Dim NomCli As String
Dim TelEnt As String
Dim PortEnt As String
Dim MailCli As String
Dim MailEnt As String
Dim AdressEnt As String
Dim VilleEnt As String
Dim MontantTTC As String
Dim objMessage As Object
Dim messageHTML As String
Dim sNomPdf As String
Dim sDossier As String
Dim sNomCrypt As String
Dim iMsg As Object
Dim iConf As Object
Dim serveurSMTP As String
sDossier = ThisWorkbook.Path
TypeDoc = Worksheets("Document").Range("F25").Value
AbreTypeDoc = Worksheets("Document").Range("G26").Value
Numdoc = Worksheets("Document").Range("H26").Value
DateDoc = Worksheets("Document").Range("G27")
HreDoc = Hour(Time) & "-" & Minute(Time)
NomCli = Worksheets("Document").Range("F31").Value
TelEnt = Worksheets("Document").Range("B32").Value
PortEnt = Worksheets("Document").Range("B33").Value
MailEnt = Worksheets("Document").Range("O36").Value
AdressEnt = Worksheets("Document").Range("B30").Value
VilleEnt = Worksheets("Document").Range("B31").Value
MailCli = Worksheets("Document").Range("F35").Value
MontantTTC = Worksheets("Document").Range("N45").Value
serveurSMTP = Worksheets("invi").Range("Y2").Value
NomFichier = AbreTypeDoc & " " & Numdoc & " du " & DateDoc
If fact = 10000 Then Exit Sub
imprim
On Error GoTo errorHandler
sNomPdf = sDossier & "\" & NomFichier & ".pdf"
Worksheets("Document").ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=sNomPdf, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
sNomCrypt = sDossier & "\" & "Tempo.pdf"
EncryptPDFUsingPdfforgeDll sNomPdf, sNomCrypt
Kill sNomPdf
Name sNomCrypt As sNomPdf
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "votre " & TypeDoc & " n° " & AbreTypeDoc & " " & Numdoc & " du " & DateDoc
objMessage.From = MailEnt
objMessage.To = MailCli
If Feuil4.Cells(25, 6) = "Proposition commerciale" Then
objMessage.TextBody = "Bonjour," & vbCrLf & vbCrLf & "Veuillez trouver ci-joint notre proposition commerciale..." & vbCrLf & vbCrLf & "Vous souhaitant bonne reception, nous restons a votre disposition pour tous renseignements." & vbCrLf & vbCrLf & "La lecture du fichier joint necessite la presence sur votre ordinateur du logiciel Adobe Acrobat Reader." & vbCrLf & "Si vous ne possedez pas ce logiciel cliquez sur : www.adobe.fr/products/acrobat/readstep.html pour le telecharger." & vbCrLf & vbCrLf & "Sinceres salutations." & vbCrLf & vbCrLf & "S. LESCARBOTTE, MaintenancePC" & vbCrLf & TelEnt & vbCrLf & PortEnt
ElseIf Feuil4.Cells(25, 6) = "Proposition commerciale acceptée" Then
objMessage.TextBody = "Bonjour," & vbCrLf & vbCrLf & "Veuillez trouver ci-joint votre proposition commerciale acceptee..." & vbCrLf & vbCrLf & "Vous souhaitant bonne reception, nous restons a votre disposition pour tous renseignements." & vbCrLf & vbCrLf & "La lecture du fichier joint necessite la présence sur votre ordinateur du logiciel Adobe Acrobat Reader." & vbCrLf & "Si vous ne possedez pas ce logiciel cliquez sur : www.adobe.fr/products/acrobat/readstep.html pour le telecharger." & vbCrLf & vbCrLf & "Sinceres salutations." & vbCrLf & vbCrLf & "S. LESCARBOTTE, MaintenancePC" & vbCrLf & TelEnt & vbCrLf & PortEnt
ElseIf Feuil4.Cells(25, 6) = "Fiche d'intervention" Then
objMessage.TextBody = "Bonjour," & vbCrLf & vbCrLf & "Veuillez trouver ci-joint la commande..." & vbCrLf & vbCrLf & "Vous souhaitant bonne reception, nous restons a votre disposition pour tous renseignements." & vbCrLf & vbCrLf & "La lecture du fichier joint necessite la presence sur votre ordinateur du logiciel Adobe Acrobat Reader." & vbCrLf & "Si vous ne possedez pas ce logiciel cliquez sur : www.adobe.fr/products/acrobat/readstep.html pour le telecharger." & vbCrLf & vbCrLf & "Sinceres salutations." & vbCrLf & vbCrLf & "S. LESCARBOTTE, MaintenancePC" & vbCrLf & TelEnt & vbCrLf & PortEnt
ElseIf Feuil4.Cells(25, 6) = "Facture" Then
objMessage.TextBody = "Bonjour," & vbCrLf & vbCrLf & "Veuillez trouver ci-joint la copie de la facture acquittee, citee en objet, d'un montant de " & MontantTTC & " euros." & vbCrLf & vbCrLf & "Vous souhaitant bonne reception, nous restons a votre disposition pour tous renseignements." & vbCrLf & vbCrLf & "La lecture du fichier joint nécessite la presence sur votre ordinateur du logiciel Adobe Acrobat Reader." & vbCrLf & "Si vous ne possedez pas ce logiciel cliquez sur : www.adobe.fr/products/acrobat/readstep.html pour le telecharger." & vbCrLf & vbCrLf & "Sinceres salutations." & vbCrLf & vbCrLf & "S. LESCARBOTTE, MaintenancePC" & vbCrLf & TelEnt & vbCrLf & PortEnt
ElseIf Feuil4.Cells(25, 6) = "Facture à régler" Then
objMessage.TextBody = "Bonjour," & vbCrLf & vbCrLf & "Veuillez trouver ci-joint la copie de la facture non acquittee, citee en objet, d'un montant de " & MontantTTC & " euros." & vbCrLf & "Le paiement est a adresse :" & vbCrLf & " " & AdressEnt & vbCrLf & " " & VilleEnt & vbCrLf & vbCrLf & "et libellé à M. LESCARBOTTE uniquement (sans autre information)" & vbCrLf & vbCrLf & "Vous souhaitant bonne réception, nous restons a votre disposition pour tous renseignements." & vbCrLf & vbCrLf & "La lecture du fichier joint necessite la présence sur votre ordinateur du logiciel Adobe Acrobat Reader." & vbCrLf & "Si vous ne posseedez pas ce logiciel cliquez sur : www.adobe.fr/products/acrobat/readstep.html pour le telecharger." & vbCrLf & vbCrLf & "Sinceres salutations." & vbCrLf & vbCrLf & "S. LESCARBOTTE, MaintenancePC" & vbCrLf & TelEnt & vbCrLf & PortEnt
'ElseIf Feuil4.Cells(25, 6) = "Avoir" Then
' objMessage.TextBody = "Bonjour," & vbCrLf & vbCrLf & "Veuillez trouver ci-joint votre avoir qui sera deduite sur la prochaine facture..." & vbCrLf & vbCrLf & "Vous souhaitant bonne reception, nous restons à votre disposition pour tous renseignements." & vbCrLf & vbCrLf & "La lecture du fichier joint necessite la presence sur votre ordinateur du logiciel Adobe Acrobat Reader." & vbCrLf & "Si vous ne possedez pas ce logiciel cliquez sur : www.adobe.fr/products/acrobat/readstep.html pour le télécharger." & vbCrLf & vbCrLf & "Sinceres salutations." & vbCrLf & vbCrLf & "S. LESCARBOTTE, MaintenancePC" & vbCrLf & TelEnt & vbCrLf & PortEnt
End If
messageHTML = "Ceci est un message en HTML"
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = serveurSMTP
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.AddAttachment sNomPdf
objMessage.Send
objMessage.MDNRequested = True
Set objMessage = Nothing
' MsgBox "Le mail a été bien envoyé au client !"
UserForm5.Show
Exit Sub
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
With iMsg
Set .Configuration = iConf
.Fields("urn:schemas:mailheader:disposition-notification-to") = MailEnt
.Fields("urn:schemas:mailheader:return-receipt-to") = MailEnt
.Fields.Update
.Send
End With
errorHandler:
MsgBox Err.Description
Feuil17.Cells(fact, 27) = "Oui" 'Ecrire Oui quand un clic est effectué
End Sub
Private Sub EncryptPDFUsingPdfforgeDll(sNomFichier As String, sOutputCrypt As String)
Dim Pdf As Object, Crypt As Object
Set Crypt = CreateObject("pdfforge.pdf.PDFEncryptor")
With Crypt
.AllowAssembly = False
.AllowCopy = False
.AllowFillIn = False
.AllowModifyAnnotations = False
.AllowModifyContents = False
.AllowPrinting = True
.AllowPrintingHighResolution = True
.AllowScreenReaders = False
.EncryptionMethod = 2
.OwnerPassword = "master"
.UserPassword = ""
End With
Set Pdf = CreateObject("pdfforge.pdf.pdf")
Pdf.EncryptPDFFile sNomFichier, sOutputCrypt, Crypt
Set Pdf = Nothing
Set Crypt = Nothing
End Sub
Private Sub CommandButton5_Click() 'Imprim document
Dim j As Integer
For j = 0 To listclient.ListCount - 1
If listclient.Selected(j) = True Then
fact = Val((listclient.List(j, 1))): factt = j + 1: nfac = fact - 1
imprim
Feuil4.PrintOut From:=1, To:=retour
End If
Next
End Sub
Private Sub CommandButton6_Click()
If fact = 10000 Then Exit Sub
imprimfacture
dep.Hide
Feuil6.PrintPreview
dep.Show
Feuil3.Select
End Sub
Private Sub CommandButton7_Click()
Dim j As Integer
For j = 0 To listclient.ListCount - 1
If listclient.Selected(j) = True Then
fact = Val((listclient.List(j, 1))): factt = j + 1: nfac = fact - 1
imprimfacture
Feuil6.PrintOut From:=1, To:=retour
End If
Next
End Sub
Private Sub CommandButton8_Click()
If fact = 10000 Then Exit Sub
donne
dep.Hide
Feuil7.PrintPreview
dep.Show
Feuil3.Select
End Sub
Private Sub CommandButton9_Click()
If fact = 10000 Then Exit Sub
donne
Feuil7.PrintOut
End Sub
Private Sub Crois_Click()
lisfact
End Sub
Private Sub etafac2_Click()
condi = etafac2.ListIndex
lisfact
End Sub
Private Sub etatfac_Click()
Dim Flg As Boolean 'MPC
If fact = 10000 Or fact = 1 Then Exit Sub
Feuil2.Cells(fact, 14) = etatfac.ListIndex
Flg = etatfac.Value <> "ANNULE" And etatfac.Value <> "DEVIS" And etatfac.Value <> "AVOIR"
paiement.Enabled = Flg
CommandButton43.Visible = Flg
TextBox10.Enabled = Flg
End Sub
Private Sub factt_Change()
If fact = 10000 Then Exit Sub
If listclient.ListCount > 1 Then listclient.ListIndex = factt - 1 Else listclient.ListIndex = -1
If factt = 0 Then fact = 10000
callcul
remet
End Sub
Private Sub listclient_Change()
If listclient.ListIndex > -1 Then fact = Val((listclient.List((listclient.ListIndex), 1))): factt = listclient.ListIndex + 1: nfac = fact - 1
End Sub
Private Sub listclient_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If fact = 10000 Then Exit Sub
dep.Hide
UserForm1.Show
End Sub
Private Sub OptionButton1_Click()
lisfact
End Sub
Private Sub OptionButton2_Click()
lisfact
End Sub
Private Sub OptionButton3_Click()
lisfact
End Sub
Private Sub paiement_Change()
If fact = 10000 Or fact = 1 Then Exit Sub
Feuil2.Cells(fact, 15) = paiement.ListIndex
If paiement = "" Then CommandButton35.Enabled = True Else CommandButton35.Enabled = False
End Sub
Private Sub paiement_Click()
If fact = 10000 Or fact = 1 Then Exit Sub
Feuil2.Cells(fact, 15) = paiement.ListIndex
End Sub
Private Sub TextBox10_Change()
If TextBox10 = "" Then CommandButton35.Enabled = True Else CommandButton35.Enabled = False
End Sub
Private Sub TextBox2_Change()
TextBox2.MaxLength = 5
If Len(TextBox2) = 2 Then TextBox2 = TextBox2 & ":"
End Sub
Private Sub TextBox4_Change()
TextBox4.MaxLength = 5
If Len(TextBox4) = 2 Then TextBox4 = TextBox4 & ":"
End Sub
Private Sub TextBox9_Change()
Dim r As Long, Y As Long
client.Clear
If TextBox9 = "" Then
For r = 2 To finf9
dep.client.AddItem Feuil9.Cells(r, 1) & " " & Feuil9.Cells(r, 3) & " (" & Feuil9.Cells(r, 4) & ")"
dep.client.List(r - 2, 1) = r
Next
Else
For r = 2 To finf9
If UCase(Mid(Feuil9.Cells(r, 3), 1, Len(TextBox9))) = UCase(TextBox9) Then
dep.client.AddItem Feuil9.Cells(r, 1) & " " & Feuil9.Cells(r, 3) & " (" & Feuil9.Cells(r, 4) & ")"
dep.client.List(Y, 1) = r
Y = Y + 1
End If
Next
End If
End Sub
Private Sub UserForm_Activate()
callcul
remet
If pamodif = True Then Exit Sub
lisfact
pamodif = True
End Sub
Private Sub UserForm_Initialize()
Dim aa
Application.DisplayAlerts = True
Application.Calculation = xlCalculationManual
moyen = Me.Height / (Application.Height - 20)
plus
messag
Set lecli = CreateObject("Scripting.Dictionary")
dico1
If Feuil3.Range("a1") = 1 Then Message
Dim r, ob As Object
Dim Cl As Classe1
fact = 2
pamodif = False
paiement.AddItem mess(16)
paiement.AddItem mess(17)
paiement.AddItem mess(18)
paiement.AddItem mess(19)
paiement.AddItem
etatfac.AddItem mess(24)
etatfac.AddItem mess(11)
etatfac.AddItem mess(25)
etatfac.AddItem mess(12)
etatfac.AddItem mess(13)
etatfac.AddItem mess(15)
etatfac.AddItem mess(14)
etatfac.AddItem mess(26)
etafac2.AddItem mess(21)
etafac2.AddItem mess(24)
etafac2.AddItem mess(11)
etafac2.AddItem mess(25)
etafac2.AddItem mess(12)
etafac2.AddItem mess(13)
etafac2.AddItem mess(15)
etafac2.AddItem mess(14)
etafac2.AddItem mess(26)
etafac2.ListIndex = 0
aa = Feuil18.Range("k2:k" & Feuil18.Range("k6500").End(xlUp).Row)
ComboBox10.List = aa
For r = 2 To finf9
dep.client.AddItem Feuil9.Cells(r, 1) & " " & Feuil9.Cells(r, 3) & " (" & Feuil9.Cells(r, 4) & ")"
dep.client.List(r - 2, 1) = r
Next
latva(1) = Feuil11.Cells(10, 2)
latva(2) = Feuil11.Cells(11, 2)
latva(3) = Feuil11.Cells(12, 2)
For Each ob In Me.Controls
Set Cl = New Classe1
If TypeOf ob Is MSForms.TextBox Then Set Cl.texb = ob: CollectBox.Add Cl
Next
Set Cl = Nothing
TextBox2.AutoTab = True
TextBox4.AutoTab = True
TextBox1.MaxLength = 10
TextBox1.AutoTab = True
TextBox10.MaxLength = 10
TextBox10.AutoTab = True
datedevis.MaxLength = 10
datedevis.AutoTab = True
ac1.AutoTab = True
ac2.AutoTab = True
ac3.AutoTab = True
datefac.MaxLength = 10
datefac.AutoTab = True
End Sub
Public Sub remet()
Dim ob As Control, g
numero = factt
If fact = 1 Then Exit Sub
If fact = 10000 Then numero = ""
For Each ob In dep.Controls
If ob.Tag > "" And ob.Tag <> "denis" And ob.Tag <> "non" Then
g = Split(ob.Tag, ",")
If Val(g(0)) > 0 Then
ob = Feuil2.Cells(fact, Val(g(0)))
Else
If UBound(g) > 0 Then ob = Feuil17.Cells(fact, Val(g(1)))
End If
End If
Next
total = Format(totalfourniture, "0.00")
total2 = Format(totalmo, "0.00")
tvaaa = Format(totvaa, "0.00")
Totalttc = Format(xttc, "0.00")
depl = Format(totaldeplace, "0.00")
If paiement <> "" Then du = "" Else du = Format(xttc - xacmpt, "0.00")
If Feuil2.Cells(fact, 15) <> "" Then paiement.ListIndex = Feuil2.Cells(fact, 15) Else paiement.ListIndex = -1
If Feuil2.Cells(fact, 14) <> "" Then etatfac.ListIndex = Feuil2.Cells(fact, 14) Else etatfac.ListIndex = Feuil11.Cells(13, 2)
End Sub
Public Sub lisfact()
If OptionButton1 = True Then condis = 3
If OptionButton2 = True Then condis = 2
If OptionButton3 = True Then condis = 1
listclient.Clear: Y = 0: nfac = ""
Select Case condi
Case 0
If Crois = False Then
For cli = finf2 To 2 Step -1
insc
Y = Y + 1
Next
Else
For cli = 2 To finf2
insc
Y = Y + 1
Next
End If
Case 1, 2, 3, 4, 5, 6, 7
If Crois = False Then
For cli = finf2 To 2 Step -1
If Feuil2.Cells(cli, 1) <> "" And Feuil2.Cells(cli, 14) = condi - 1 Then
insc
Y = Y + 1
End If
Next
Else
For cli = 2 To finf2
If Feuil2.Cells(cli, 1) <> "" And Feuil2.Cells(cli, 14) = condi - 1 Then
insc
Y = Y + 1
End If
Next
End If
End Select
factt.Max = listclient.ListCount
If factt.Max > 0 Then fact = 2 Else fact = 10000
If factt.Max > 0 Then listclient.ListIndex = 0 Else listclient.ListIndex = -1
callcul
remet
End Sub
Public Sub insc()
Select Case condis
Case 0, 1
listclient.AddItem Feuil2.Cells(cli, 3)
Case 2
listclient.AddItem Feuil2.Cells(cli, 9)
Case 3
listclient.AddItem Feuil2.Cells(cli, 11)
End Select
listclient.List(Y, 1) = cli
End Sub
Sub NouveauRDV_Calendrier()
Dim OkApp As New Outlook.Application
Dim Rdv As Outlook.AppointmentItem
Set Rdv = OkApp.CreateItem(olAppointmentItem)
With Rdv
.MeetingStatus = olMeeting
.Subject = nom.Value
.Body = libel.Value
If deplac = True Then .Location = "au bureau" Else .Location = "à domicile"
.Start = TextBox1.Value & " " & TextBox4.Value ' Attention : format mois/jours/année
.Duration = 60 'minutes
.Categories = "Clients"
.ReminderSet = True
.ReminderMinutesBeforeStart = 60
.ReminderPlaySound = True
.Mileage = TextBox7.Value
.BusyStatus = olOutOfOffice
.Save
End With
Set OkApp = Nothing
End Sub |
Partager