Sujet Précédent Sujet Suivant

Combobx sur Userform ...Bon de commande

VBAnaute Messages postés 3 Date d'inscription jeudi 15 décembre 2005 Statut Membre Dernière intervention 22 décembre 2005 - 16 déc. 2005 à 11:59
mortalino Messages postés 6786 Date d'inscription vendredi 16 décembre 2005 Statut Membre Dernière intervention 21 décembre 2011 - 14 sept. 2006 à 05:38
Bonjour à toutes et tous.
Tout d'abord merci à celui, celle, ceux, qui pourront m'aider.

Mon souci est le suivant:

Je tente depuis un petit temps maintenant d'introduire dans une Combobx dans un Userform la colonne A1:A6 qui se trouve su la feuille HARDPC.

Je souhaite de manière général, sélectionner un intitulé (Colonne A1:A6) et récupérer les infos de la ligne pour les envoyer sur d'autres feuilles.

En résumé mon Userform me serviraitt grâce aux combobox à sélectionner les produits sur différentes feuilles et en resortir toutes les références avec photos et ... sur une feuille.
Feuille qui serait mon Bon de Commande.

Merci à tous et déjà d'EXCELlentes fêtes de fin d'années.

VBAnaute.

6 réponses

Réponse 1 / 6
jpleroisse Messages postés 1788 Date d'inscription mardi 7 novembre 2000 Statut Membre Dernière intervention 11 mars 2006 27
16 déc. 2005 à 15:28
Bonjour,

Pour remplir un combobox avec les données de la colonne A



Private Sub UserForm_Initialize()

Dim n As Integer

n = 1

Do While (Cells(n, 1) <> "")

UserForm1.ComboBox1.AddItem Cells(n, 1).Value

n = n + 1

Loop

End Sub



jpleroisse



Si une réponse vous convient, cliquez Réponse Acceptée.
0
Réponse 2 / 6
mortalino Messages postés 6786 Date d'inscription vendredi 16 décembre 2005 Statut Membre Dernière intervention 21 décembre 2011 18
20 déc. 2005 à 11:14
Salut,

Tu peux aussi mettre ce code :

With Sheets("HARDPC").Range("A1")

Me.ComboBox1.RowSource = "HARDPC!A1:A" & Sheets("HARDPC").Cells(1, 1).End(xlDown).Row

End With

'''' n'oublie pas de remplacer Combobox1 par le nom que tu lui a donné !

Bonnes fêtes de fin d'année à toi aussi !!


Mortalino
0
Réponse 3 / 6
mortalino Messages postés 6786 Date d'inscription vendredi 16 décembre 2005 Statut Membre Dernière intervention 21 décembre 2011 18
14 juil. 2006 à 21:20




































0
Réponse 4 / 6
mortalino Messages postés 6786 Date d'inscription vendredi 16 décembre 2005 Statut Membre Dernière intervention 21 décembre 2011 18
14 juil. 2006 à 23:41
TEST : (g des problème de signature)



Sub
Couleur_De_Fond_Cellule()<?xml:namespace prefix o ns "urn:schemas-microsoft-com:office:office" /?>






 






' Dans le menu "projet", "référence", sélectionner Microsoft Excel 11.0 Library






 







 








 







   

Dim
xlApp
As
Excel.Application






 







   

Dim
xlBook
As
Workbook






 







   

Dim
xlSheet
As
Worksheet






 







 








 







   

' référence Excel, le Classeur et la feuille






 







       

Set
xlApp = CreateObject(
"Excel.Application"
)






 







    xlApp.Visible =
True









 







       

Set
xlBook = xlApp.Workbooks.Open(
"C:\Chemin\Fichier.xls"
)






 







       

Set
xlSheet = xlBook.Sheets(
"Feuil1"
)
' mettre le nom de ta feuille






 







 








 






' change la couleur de fond de la cellule A1






 






xlSheet.Range(
"A1"
).Interior.ColorIndex =
4


'(vert)






 







 








 






xlBook.Close
True


' ferme le classeur en l'enregistrant






 






xlApp.Quit
' Tue le processus Excel






 







 








 







       

' vide les mémoires






 







       

Set
xlApp =
Nothing









 







       

Set
xlBook =
Nothing









 







 








 






End


Sub









 







 











@++



   Mortalino
Le mystérieux chevalier, "Provençal, le Gaulois"
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 6
mortalino Messages postés 6786 Date d'inscription vendredi 16 décembre 2005 Statut Membre Dernière intervention 21 décembre 2011 18
15 juil. 2006 à 00:05
Sub



Couleur_De_Fond_Cellule()


' Dans le menu "projet", "référence", sélectionner Microsoft Excel 11.0 Library





Dim




xlApp


As

Excel.Application



Dim




xlBook


As

Workbook



Dim




xlSheet


As

Worksheet



' référence Excel, le Classeur et la feuille




Set




xlApp = CreateObject(


"Excel.Application"

)xlApp.Visible =



TrueSet



xlBook = xlApp.Workbooks.Open(


"C:\Chemin\Fichier.xls"

)



Set




xlSheet = xlBook.Sheets(


"Feuil1"

)


' mettre le nom de ta feuille' change la couleur de fond de la cellule A1




xlSheet.Range(




"A1"
).Interior.ColorIndex =

4



'(vert)

xlBook.




Close True



' ferme le classeur en l'enregistrant

xlApp.Quit





' Tue le processus Excel' vide les mémoires




Set



xlApp = Nothing


Set



xlBook = Nothing


End Sub














@++



   Mortalino
Le mystérieux chevalier, "Provençal, le Gaulois"
0
Réponse 6 / 6
mortalino Messages postés 6786 Date d'inscription vendredi 16 décembre 2005 Statut Membre Dernière intervention 21 décembre 2011 18
14 sept. 2006 à 05:38
Désolé, encore des tests à faire (là c'est pour la bonne cause, c'est ma source).
En cas, pour ne pas t'embêter, pense à lever l'alerte mail 

Option Explicit 

Private AfManifest As New Cls_Manifest 
    Dim db As Database 
    Dim NomBase As String 
    Dim NumPictureDef As String 
    

Private Sub cbtListeComplete_Click() 
    Dim Rs As Recordset 
    Dim sql As String 
    Dim NbNomProduits As Integer 
    
lbxNomProduits.Clear 

NomBase = App.Path & "\TMD.mdb"
If Dir(NomBase) <> ""Then 
    NbNomProduits = 0 
    
' **** on selectionne tous les produits de la table pour affichage dans la ListBox
    Set db = DBEngine.Workspaces(0).OpenDatabase(NomBase) 
sql = "SELECT NomProduit FROM ListeProduit"
    Set Rs = db.OpenRecordset(sql) 
        Rs.MoveFirst 
    
    Do While Rs.EOF = False 
        Me.lbxNomProduits.AddItem Rs!NomProduit 
        NbNomProduits = NbNomProduits + 1 
        Rs.MoveNext 
    Loop 
    
    Set Rs = Nothing 
    db.Close 
Else 
    MsgBox "Le fichier Tmd.mdb n'est pas présent dans "& App.Path, vbCritical, "ATTENTION"
End If 

End Sub 

Private Sub cbtQuitter_Click() 
    End 
End Sub 

Private Sub cbtValider_Click() 
    Dim Rs As Recordset 
    Dim sql As String 
    Dim CodeDangerU As String 
    Dim CodeMatiereU As String 
    Dim NbNomProduits As Integer 
    
lbxNomProduits.Clear 

NomBase = App.Path & "\TMD"
NbNomProduits = 0 
CodeDangerU = Me.tbxCodeDanger.Text 
CodeMatiereU = Me.tbxCodeMatiere.Text 

' **** recherche par code danger & matière
    Set db = DBEngine.Workspaces(0).OpenDatabase(NomBase) 
sql = "SELECT NomProduit FROM ListeProduit WHERE CodeDanger='"& CodeDangerU & "' AND CodeMatiere='"& CodeMatiereU & "'"
        On Error GoTo MessageErr 
    Set Rs = db.OpenRecordset(sql) 
    Rs.MoveFirst 

Do While Rs.EOF = False 
    Me.lbxNomProduits.AddItem Rs!NomProduit 
    NbNomProduits = NbNomProduits + 1 
    Rs.MoveNext 
Loop 

Set Rs = Nothing 
db.Close 

Exit Sub 
MessageErr: 
MsgBox "Il n'y a aucun produit correspondant"& vbCrLf & _ 
        "au code danger "& CodeDangerU & " et au code matière "& CodeMatiereU 
End Sub 

Private Sub cbxTDefilant_Click() 
' **** Mise en route du texte défilant (speed, Command, Execute)

    If Me.cbxTDefilant.Value = vbChecked Then 
        Me.lblNomProduit.Speed = Me.scbVitesse.Value 
        With lblNomProduit 
            .Command ("start")
            .Execute ("start")
        End With 
    Else 
        With lblNomProduit 
            .Command ("stop")
            .Execute ("stop")
        End With 
    End If 
End Sub 

Private Sub Form_Load() 
' classe
    AfManifest.Run 

NomBase = App.Path & "\TMD.mdb"

End Sub 

Private Sub Form_Unload(Cancel As Integer) 
' libère mémoire. aucune fonction liée
    Set AfManifest = Nothing 
    Set db = Nothing 
    
End Sub 

Private Sub lbxNomProduits_Click() 
    Dim NomProduitU As String 
    Dim NomProduitU2 As String 
    Dim sql As String 
    Dim FichierPicture As String 
    Dim NbNomProduits As Integer 
    Dim Rs As Recordset 
    
NomProduitU2 = Me.lbxNomProduits 
NomProduitU = Replace(NomProduitU2, "'","''")
Me.lblNomProduit.Text = NomProduitU2 
    
' *** selection des infos selon le produit choisi
        Set db = DBEngine.Workspaces(0).OpenDatabase(NomBase) 
sql = "SELECT * FROM ListeProduit WHERE NomProduit='"& NomProduitU & "'"
        Set Rs = db.OpenRecordset(sql) 
        
' **** remplissage des infos dans les labels
    Me.lblCodeDanger.Caption = Rs!CodeDanger 
    Me.lblCodeMatiere.Caption = Rs!CodeMatiere 
    Me.lblChiffreEnumeration.Text = Rs!ChiffreEnumeration 
    Me.lblClasseEnumeration.Text = Rs!ClasseEnumeration 
    Me.lblSymboleDanger.Text = Rs!SymboleDanger 
    
    If Rs!EC <> vbNull Then 
        Me.lblEC.Text = Rs!EC 
    Else 
        Me.lblEC.Text = "non"
    End If 

        Set Rs = Nothing 
db.Close 

Call Charge_Image 
'MsgBox NumPictureDef

FichierPicture = App.Path & "\Prog TMD\Symbole "& NumPictureDef & ".jpg"
pctSymbole.Picture = LoadPicture(FichierPicture) 

End Sub 

Sub scbVitesse_Change() 
'With lblNomProduit
' .Command ("stop")
' .Execute ("stop")
'End With
    Me.lblNomProduit.Speed = Me.scbVitesse.Value 
'With lblNomProduit
' .Command ("start")
' .Execute ("start")
'End With
End Sub 

Sub Charge_Image() 
    Dim i As Long 
    Dim NbCaract As Long 
    Dim NumPictureTemp As String 
    Dim Caract As String 
    
NumPictureTemp = Me.lblSymboleDanger.Text 
NbCaract = Len(NumPictureTemp) 
NumPictureDef = ""

For i = 1 To NbCaract 
    Caract = Mid(NumPictureTemp, i, 1) 
    If Caract = " "Or Caract = ","Or Caract = ""Or Caract = "-"Then 
        Exit For 
    Else 
        NumPictureDef = NumPictureDef & Caract 
    End If 
Next i 

End Sub 

@++

<hr width="100%" size="2" />
  --Mortalino--
Le mystérieux chevalier, "Provençal, le Gaulois"
/DIV>
0
Rejoignez-nous