Option Explicit
Dim Buttons() As New Boutons
'===========================================================
Private Sub CommandButton43_Click() 'Aide
Load UserForm7
UserForm7.MultiPage1.Value = 6
UserForm7.Show
End Sub
Private Sub Label3_Click()
End Sub
Private Sub ListBox1_Click()
End Sub
Private Sub CommandButton28_AfterUpdate()
Me.ListBox1.SetFocus
End Sub
'===========================================================
Private Sub UserForm_Activate() 'Commande Alpha -- Bibli vers facture
Dim X%
Dim ButtonCount%
Dim ctl As Control
UserForm11.Caption = "Entrée Désignation sur la Facture"
ButtonCount = 0
For Each ctl In UserForm11.Controls
If TypeName(ctl) = "CommandButton" Then
If ctl.Name <> "ValiderButton" Or ctl.Name <> "ImprimerButton" _
Or ctl.Name <> "QuitterButton" Or ctl.Name <> "DésignatioButton" _
Or ctl.Name <> "RéférenceButton" Then ' ignorer les boutons Valider,Imprimer,Quitter,Désignation,Référence
ButtonCount = ButtonCount + 1
ReDim Preserve Buttons(1 To ButtonCount)
Set Buttons(ButtonCount).ButtonGroup = ctl
' MsgBox ButtonCount
End If
End If
Next ctl
X = Sheets("Feuil2").Range("E2").Value
Call box1(X)
UserForm11.Frame2.Visible = False
Sheets("Feuil1").Activate
End Sub
'===========================================================
Sub box1(X) 'action sur la "ListBox" de l'Userform11
Dim Nb%, NblC%, NblB%
Dim Cq%, Dix%, Uni%
Dim DonnéesB$, DonnéesC$, DonnéesD$
Dim DonnéesBB$, i%
Cq = 65
Dix = 13
Uni = 5
Nb = Sheets("Feuil2").Range("E2").Value
UserForm11.Label1.Caption = Sheets("Feuil2").Range("B2").Value & " (Q = " & X & "/" & Nb & ")"
Label2.Caption = Space(55) & "Désignation" & Space(80) & "Unité" & Space(5) & "Prix Unitaire($)"
For i = 1 To Nb
DonnéesBB = Sheets("Feuil2").Range("B" & i + 2).Value
DonnéesC = Sheets("Feuil2").Range("C" & i + 2).Value
DonnéesD = Sheets("Feuil2").Range("D" & i + 2).Value
'------------------ traitement espace colonne B -----------------------
NblB = Len(DonnéesBB)
DonnéesB = Left(DonnéesBB, Cq - 2)
If NblB > Cq Then
NblB = Cq - 2
End If
'-----------------------------------------------------------------------
NblC = Len(DonnéesC)
With UserForm11.ListBox1
.AddItem DonnéesB & Space(Cq - NblB) & DonnéesC & Space(Uni - NblC) & DonnéesD
.Font = "courier new"
End With
Next i
Sheets("Feuil1").Activate
End Sub
'===========================================================
Sub Referencebox1() '(X) 'action sur la "ListBox" de l'Userform11
Dim Nb%, Cq%, Dix%, i%, Z%, Uni%
Dim DonnéesA$, DonnéesC$, DonnéesD$
Dim DonnéesB$, DonnéesBB$
Dim NblC%, NblB%, NblA%
Dim Devise$
Devise = Sheets("Feuil1").Range("A110").Value
'Sheets("Feuil2").Activate
UserForm11.ListBox1.Clear
Nb = Sheets("Feuil2").Range("E2").Value
Z = 0
Dix = 13
Cq = 65
Uni = 5
For i = 1 To Nb
DonnéesA = Sheets("Feuil2").Range("A" & i + 2).Value
If DonnéesA <> "" Then
NblA = Len(DonnéesA)
DonnéesBB = Sheets("Feuil2").Range("B" & i + 2).Value
DonnéesC = Sheets("Feuil2").Range("C" & i + 2).Value
DonnéesD = Sheets("Feuil2").Range("D" & i + 2).Value
NblC = Len(DonnéesC)
'------------------ traitement espace colonne B -----------------------
NblB = Len(DonnéesBB)
DonnéesB = Left(DonnéesBB, Cq - 2)
If NblB > Cq Then
NblB = Cq - 2
End If
'-----------------------------------------------------------------------
With UserForm11.ListBox1
.AddItem DonnéesA & Space(Dix - NblA) & DonnéesB & Space(Cq - NblB) & DonnéesC & Space(Uni - NblC) & DonnéesD
.Font = "courier new"
End With
Z = Z + 1
End If
Next
UserForm11.Label1.Caption = Sheets("Feuil2").Range("B2").Value & " (Q = " & Z & "/" & Nb & ")"
Label2.Caption = Space(12) & "Référence" & Space(55) & "Désignation" & Space(80) & "Unité" & Space(5) & "Prix Unitaire (" & Devise & ")"
Sheets("Feuil1").Activate
End Sub
'===========================================================
Sub Bouton_Choisi(LettreSelect)
'MsgBox LettreSelect
Dim DonnéesA$, Motif$, DonnéesB$, Lettre$
Dim DonnéesC$, DonnéesD$, DonnéesBB$
Dim X%, Vtemp As Variant, i%, J%
Dim Dix%, Cq%, Uni%
Dim NblA%, NblB%, NblC%, Y%, Nb%
Dim Devise$
Devise = Sheets("Feuil1").Range("A110").Value
Nb = Sheets("Feuil2").Range("E2").Value
X = 0 'compteur de désignation sélectionné
Y = 0 'compteur donne la position de la première désignation trouvé
Cq = 65
Dix = 13
Uni = 5
If LettreSelect = "Valider" Then Exit Sub
If LettreSelect = "Imprimer" Then Exit Sub
If LettreSelect = "Quitter" Then Exit Sub
If LettreSelect = "Désignation" Then Exit Sub
If LettreSelect = "Référence" Then Exit Sub
'------------------------- Choix Désignation ou Référence -----------------------
Motif = CommandButton41.Caption
If Motif = "Désignation" Then
UserForm11.ListBox1.Clear
'------------------------- Bibli entière Référence ----------------------
If LettreSelect = "*" Then
' X = Nb
Call Referencebox1 '(X)
Exit Sub
End If
'------------------------- Bibli partielle Référence --------------------
UserForm11.ListBox1.Clear
X = 0
For i = 1 To Nb
DonnéesA = Sheets("Feuil2").Range("A" & i + 2).Value
Lettre = UCase(Left(DonnéesA, 1))
If LettreSelect = Lettre Then 'comparaison lettre du bouton..
DonnéesBB = Sheets("Feuil2").Range("B" & i + 2).Value
DonnéesC = Sheets("Feuil2").Range("C" & i + 2).Value
DonnéesD = Sheets("Feuil2").Range("D" & i + 2).Value
'------------------ traitement espace colonne B -----------------------
NblB = Len(DonnéesBB)
DonnéesB = Left(DonnéesBB, Cq - 2)
If NblB > Cq Then
NblB = Cq - 2
End If
'-----------------------------------------------------------------------
NblA = Len(DonnéesA)
NblB = Len(DonnéesB)
NblC = Len(DonnéesC)
UserForm11.ListBox1.AddItem DonnéesA & Space(Dix - NblA) & DonnéesB & Space(Cq - NblB) _
& DonnéesC & Space(Uni - NblC) & DonnéesD
X = X + 1
End If
Next
'--------------------- Tri sur Listbox ------------------------------
With ListBox1
For i = 0 To .ListCount - 1
For J = 0 To .ListCount - 1
'MsgBox .List(i)
If .List(i) < .List(J) Then
Vtemp = .List(i)
.List(i) = .List(J)
.List(J) = Vtemp
End If
Next J
Next i
End With
UserForm11.Label1.Caption = Sheets("Feuil2").Range("B2").Value & " (Q = " & X & "/" & Nb & ")"
End If
'------------------------- Bibliothèque entière désignation ---------------------
If Motif = "Référence" Then
If LettreSelect = "*" Then
UserForm11.ListBox1.Clear
X = Nb
Call box1(X)
Exit Sub
End If
'------------------------ Bibliothèque partielle désignation --------------------
UserForm11.ListBox1.Clear
For i = 1 To Nb
DonnéesBB = Sheets("Feuil2").Range("B" & i + 2).Value
DonnéesC = Sheets("Feuil2").Range("C" & i + 2).Value
DonnéesD = Sheets("Feuil2").Range("D" & i + 2).Value
NblC = Len(DonnéesC)
Lettre = UCase(Left(DonnéesBB, 1))
' MsgBox Lettre
'------------------ traitement espace colonne B -----------------------
NblB = Len(DonnéesBB)
DonnéesB = Left(DonnéesBB, Cq - 2)
If NblB > Cq Then
NblB = Cq - 2
End If
'-----------------------------------------------------------------------
If LettreSelect = Lettre Then 'comparaison lettre du bouton..
X = X + 1
UserForm11.ListBox1.AddItem DonnéesB & Space(Cq - NblB) & DonnéesC _
& Space(Uni - NblC) & DonnéesD
End If
Next
'--------------------- Tri sur Listbox ------------------------------
With ListBox1
For i = 0 To .ListCount - 1
For J = 0 To .ListCount - 1
'MsgBox .List(i)
If .List(i) < .List(J) Then
Vtemp = .List(i)
.List(i) = .List(J)
.List(J) = Vtemp
End If
Next J
Next i
End With
UserForm11.Label1.Caption = Sheets("Feuil2").Range("B2").Value & " (Q = " & X & "/" & Nb & ")"
Label2.Caption = Space(55) & "Désignation" & Space(80) & "Unité" & Space(5) & "Prix Unitaire (" & Devise & ")"
End If
Sheets("Feuil1").Activate
End Sub
'===========================================================
Private Sub CommandButton28_Click() 'Valider
Dim i%, X%, NblB%, Lgv%, Z%, Dnb%, Nb%
Dim Element_Select As Boolean, BibliA$, Bibli$
Dim NbDon%, NbL%, Ligne%, Uni%, Page%
Dim Selection$, BibliB$, BibliC$
Dim BibliD$, BibliBB$, NomFiche$, Motif$
Dim NblC%, NblA%, Cq%, Dix%, J%, report1&
Dim Devise$, Form$, F1$, F2$
'----------------------------------------
F1 = "Feuil1"
F2 = "Feuil2"
'----------- Format devise -----------
Devise = Sheets(F1).Range("A110").Value
If Devise = "xpf" Then
Form = "###,##0[$ " & Devise & "-1]"
Else
Form = "###,##0.00[$ " & Devise & "-1]"
End If
'-------------------------------------
Element_Select = False
Nb = UserForm1.ListBox1.ListCount
Sheets(F1).Activate
Page = 1
Page = Worksheets(F1).Range("G8").Value
Motif = CommandButton41.Caption
Cq = 65
Dix = 13
Uni = 5
'-------------- REPORTE LE DEVIS H.T. DE LA PAGE PRECEDENTE ------------
If Page > 1 Then
Page = Page - 1
Worksheets(6).Select
NomFiche = ActiveSheet.Name
Sheets(NomFiche).Select
report1 = Sheets(NomFiche).Range("G49").Value 'report feuille précédente hors taxe
Sheets(F1).Select
Sheets(F1).Unprotect
Sheets(F1).Range("D47").Value = "page" & Page
Sheets(F1).Range("G47").Value = report1
Sheets(F1).Protect
End If
' *******************************************
' Début modification le 11/03/64 par Banzai64
' *******************************************
'NbDon = Worksheets(F1).Range("A7").Value 'Nombre d'article enregistré sur la Facture
'
''----------- ECRITURE DES DONNEES 1 SUR 2 SI LIGNE DEVIS < A 15 ----------
'If NbDon >= 17 Then
' Lgv = 1
' VBAProject.UserForm1.SupLig_Vide_Devis
'Else
' Lgv = 2
'End If
'
''-------------------- Dépassement -------------------------------
'If NbDon = 33 Then 'limite le nombre de ligne sur le Devis
' MsgBox "Vous avez dépassez le nombre de donné du devis", vbExclamation, "FACTURE DEVIS"
' Exit Sub
'End If
' *******************************************
' Début modification le 11/03/64 par Banzai64
' *******************************************
'----------------------- Initialisation --------------------------------
NbL = UserForm11.ListBox1.ListCount
Sheets(F1).Activate
X = 3 'Ligne de départ des données "Feuil2"
Z = 11 'Ligne de départ sur la "Feuil1"
Dnb = Sheets(F2).Range("E2").Value
Sheets(F1).Unprotect
Sheets(F1).Range("F11:G58").NumberFormat = Form
Sheets(F1).Protect
'------------ Enregistrement des données sur la feuille Facture ---------------
For i = 0 To NbL - 1
If UserForm11.ListBox1.Selected(i) Then
Element_Select = True
' *******************************************
' Début modification le 11/03/64 par Banzai64
' *******************************************
NbDon = Worksheets(F1).Range("A7").Value 'Nombre d'article enregistré sur la Facture
'----------- ECRITURE DES DONNEES 1 SUR 2 SI LIGNE DEVIS < A 15 ----------
If NbDon >= 17 Then
Lgv = 1
VBAProject.UserForm1.SupLig_Vide_Devis
Else
Lgv = 2
End If
'-------------------- Dépassement -------------------------------
If NbDon = 33 Then 'limite le nombre de ligne sur le Devis
MsgBox "Vous avez dépassez le nombre de donné du devis", vbExclamation, "FACTURE DEVIS"
Exit Sub
End If
' *******************************************
' Fin modification le 11/03/64 par Banzai64
' *******************************************
Ligne = NbDon * Lgv
' *******************************************
' Début modification le 11/03/64 par Banzai64
' *******************************************
Selection = Me.ListBox1.List(i)
Me.ListBox1.Selected(i) = False
'Selection = UserForm11.ListBox1.Value
' *******************************************
' Fin modification le 11/03/64 par Banzai64
' *******************************************
For J = 0 To Dnb - 1
BibliBB = Sheets(F2).Range("B" & J + X).Value
BibliC = Sheets(F2).Range("C" & J + X).Value
BibliD = Sheets(F2).Range("D" & J + X).Value
NblC = Len(BibliC)
'------------------ traitement espace colonne B -----------------------
NblB = Len(BibliBB)
BibliB = Left(BibliBB, Cq - 2)
If NblB > Cq Then
NblB = Cq - 2
End If
'-----------------------------------------------------------------------
Bibli = BibliB & Space(Cq - NblB) & BibliC & Space(Uni - NblC) & BibliD
'--------------------- Traitement sur référence -----------------
If Motif = "Désignation" Then
BibliA = Sheets(F2).Range("A" & J + X).Value
BibliC = Sheets(F2).Range("C" & J + X).Value
BibliD = Sheets(F2).Range("D" & J + X).Value
If BibliA <> "" Then
NblA = Len(BibliA)
Bibli = BibliA & Space(Dix - NblA) & Bibli
End If
End If
'----------------------------------------------------------------
If Selection = Bibli Then
Cells(i + X, 1).Select
Cells(Z + Ligne, 1).Offset(0, 0) = Sheets(F2).Cells(J + X, 1).Value 'référence
Cells(Z + Ligne, 1).Offset(0, 1) = Sheets(F2).Cells(J + X, 2).Value 'désignatiön
Cells(Z + Ligne, 1).Offset(0, 2) = Sheets(F2).Cells(J + X, 3).Value 'unité
Cells(Z + Ligne, 1).Offset(0, 5) = Sheets(F2).Cells(J + X, 4).Value 'prix unitaire
Cells(Z + Ligne, 1).Select
End If
Next J
End If
Next i
'----------- DETECTION D'ERREUR (PAS DE SELECTION)---------------
If Element_Select = False Then
MsgBox "vous n'avez rien sélectionné: fin du programme", , "FACTURE DEVIS"
Exit Sub
End If
End Sub
'===========================================================
Private Sub CommandButton29_Click() 'Imprimer
UserForm11.BackColor = RGB(255, 255, 255) 'Blanc
UserForm11.Frame1.BackColor = RGB(255, 255, 255)
UserForm11.PrintForm
UserForm11.BackColor = RGB(255, 255, 200) 'Jaune
UserForm11.Frame1.BackColor = RGB(242, 169, 4) 'orange
End Sub
'===========================================================
Private Sub CommandButton30_Click() 'Quitter
Sheets("Feuil1").Select
Unload Me
End Sub
'===========================================================
Private Sub CommandButton41_Click() 'Désignation ou Référence
Dim Motif$, LettreSelect$
Motif = CommandButton41.Caption
'---------------- Modification Couleur et Texte ---------------
If Motif = "Désignation" Then
UserForm11.Label3.Caption = "Mode Désignation"
CommandButton41.Caption = "Référence"
UserForm11.Frame2.Visible = False
With CommandButton41
.BackColor = RGB(100, 255, 255) 'bleu
With .Font
.Size = 8
.Bold = True
End With
End With
LettreSelect = Chr(42)
Call Bouton_Choisi(LettreSelect)
ElseIf Motif = "Référence" Then
UserForm11.Label3.Caption = "Mode Référence"
CommandButton41.Caption = "Désignation"
UserForm11.Frame2.Visible = True
With CommandButton41
.BackColor = RGB(100, 255, 100) 'vert
With .Font
.Size = 8
.Bold = True
End With
End With
LettreSelect = Chr(42)
Call Bouton_Choisi(LettreSelect)
End If
End Sub