Intégrer Formule dans Userform Excel 2016 64bits

Bonjour, j'ai créé un formulaire Userform sous excel 2016 64bits

Je souhaite qu'en cellule textbox30 apparaisse un message "REFUS" ou "ACCEPTE" si textbox31 est supérieur ou égale à 4% de Textbox17

Il y a une condition c'est que textbox17 ou textbox31 soit rempli et optionbutton2 soit coché

J'ai écris celà mais ça ne marche pas.

Ce n'est pas réversible

Je n'arrive pas à avoir le pourcentage permettant d'être le paramètre de REFUS ou ACCEPTE

A savoir que si le résultat s'affiche, il faudra que si je retire un des 3 paramètres, la textbox30 redevient vide

Private Sub TextBox31_Change()
If TextBox17.Text <> "" And TextBox31.Text <> "" And OptionButton2.Value = True Then
If TextBox31.Value / TextBox17.Value >= 1 Then TextBox30.Value = "REFUSE"
Else
If TextBox31.Value / TextBox17.Value < 1 Then TextBox30.Value = "ACCEPTE"
Else
If TextBox17.Text = "" Or TextBox31.Text = "" Then TextBox30.Value = ""
End If

End Sub

Grand merci pour votre aide

Bonjour Toutouf

Un Textbox contient comme son nom l'indique du texte

Il faut donc convertir les valeurs dans 2 variables As Double pour faire le calcul et comparer

A+

Ouh la je ne sais pas faire cela

Bonjour,

Prenez l'habitude de mettre systématiquement le fichier KIVABIEN avec.

Et pas un exemple mais un vrai fichier ou seules les données sensibles sont "bidonnées". (email, adresse, téléphone...°

Pour les bases de données une ou 2 lignes suffisamment représentatives peuvent suffire.

Pour passer du code veuillez utiliser la balise </> avant de coller votre code.

Excel 2016 en 84 bits est assez rare : C'est Windows qui est en 64 bits mais Excel est en général en 32 bits.

Veuillez vérifier Fichier > Compte > A propos d'Excel

puis...

A+

Je vérifie de suite et vais vous donner le fichier pour avoir votre support; merci et à tout à l'heure

Voilà le code

<> Private Sub TextBox31_Change()
If TextBox17.Text <> "" And TextBox31.Text <> "" And OptionButton2.Value = True Then
If TextBox31.Value / TextBox17.Value >= 1 Then TextBox30.Value = "REFUSE"
Else
If TextBox31.Value / TextBox17.Value < 1 Then TextBox30.Value = "ACCEPTE"
Else
If TextBox17.Text = "" Or TextBox31.Text = "" Then TextBox30.Value = ""
End If

End Sub

Voilà, j'espère avoir suffisamment donner d'informations.

Pareil, j'ai une macro pour intégrer des photos et les dimensionner en rapport à la cellule mais je n'arrive pas à la mettre dans une cellule précise, ça me met uniquement dans la cellule active. Si vous pouviez m'aider aussi ça m'aiderait beaucoup.

Un grand merci à toute la communauté.

Bonjour,

Vu que ce ne sont que des quantités, Single est suffisant à mes yeux et voici ce que ça donne
Voilà comment transformer du texte en Single (CSng) ou Double (CDbl)

Private Sub TextBox31_Change()
  Dim Val1 As Single, Val2 As Single
  If TextBox17.Text <> "" And TextBox31.Text <> "" And OptionButton2.Value = True Then
    Val1 = CSng(Me.TextBox17): Val2 = CSng(Me.TextBox31)
    If (Val2 / Val1) >= 1 Then
      Me.TextBox30.Value = "REFUSE"
    ElseIf (Val2 / Val1) < 1 Then
      Me.TextBox30.Value = "ACCEPTE"
    End If
  Else
    Me.TextBox30.Value = ""
  End If
End Sub

Par contre pour votre test (>=1), je ne vois pas comment cela peut être supérieur à 100% des pièces

A+

Bonjour JExcel2 et grand merci,

Je vais changer la variable de refus ou accepté maintenant que l'ossature est défini. Je n'ai pas le niveau suffisant pour pouvoir faire ce qu'accompli par vous.

Par contre, en enlevant la quantité contrôlé et/ou enlever le bouton prod, le résultat reste.

Comment faire pour que si un des 3 paramètres est retiré, le résultat se retire ?

Et de plus , en fait c'est que si Textbox31 est supérieur ou égale à 3.99% de Textbox17 alors "REFUSE" sinon accepté

Re,

Par contre, en enlevant la quantité contrôlé et/ou enlever le bouton prod, le résultat reste.

Forcément, l'évènement "Change" n'est que pour la saisie dans le TextBox31

Vous avez une formation ici https://www.excel-pratique.com/fr/vba/evenements_classeur

Et de plus , en fait c'est que si Textbox31 est supérieur ou égale à 3.99% de Textbox17 alors "REFUSE" sinon accepté

3,99%, le résultat fait combien pour vous en nombre ....

A+

et ben oui ca fait 0.0399, quel idiot !

Merci beaucoup de votre réactivité,

Sur la sub suivante

<>Private Sub CommandButton1_Click()
Dim PicList() As Variant
Dim PicFormat As String
Dim Rng As Range
Dim sShape As Shape
Dim pict As IPictureDisp, coeff As Double
On Error Resume Next
PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
xColIndex = Application.ActiveCell.Column
If IsArray(PicList) Then
xRowIndex = Application.ActiveCell.Row
For lLoop = LBound(PicList) To UBound(PicList)
Set Rng = Cells(xRowIndex, xColIndex)
Set pict = LoadPicture(PicList(lLoop))
coeff = pict.Width / pict.Height
Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), True, True, Rng.Left, Rng.Top, IIf(Rng.Width < Rng.Height, Rng.Width, Rng.Height * coeff), IIf(Rng.Width > Rng.Height, Rng.Height, Rng.Width / coeff))
xRowIndex = xRowIndex + 1
Next
End If
End Sub

Comment faire pour que la photo aille dans une cellule défini et non dans la cellule active ?

Promis après je vous laisse tranquille

Re,

Voici un exemple de sub à adapter à votre besoin

Sub Image()
  Dim FichierImage As String
  Dim NomFeuille As String
  FichierImage = Worksheets("Feuil1").Range("D7").Value
  NomFeuille = "Feuil1"
  InsérerImage NomFeuille, Range("D7"), FichierImage
End Sub

Sub InsérerImage(Feuille As String, RgImage As Range, _
                                    NomImage As String)
 Dim Rg As Range, Image As Picture
 Set Rg = Worksheets(Feuille).Range(RgImage.Address)
    With Rg
        Largeur = .Offset(, 1)(, .Columns.Count).Left - .Left
        Hauteur = .Offset(.Rows.Count).Top - .Item(1).Top
        Set Image = Worksheets(Feuille).Pictures.Insert(NomImage)
    End With
    With Image
        .ShapeRange.LockAspectRatio = msoFalse
        .Left = Rg.Left
        .Top = Rg.Top
        'Largeur de l'image
        Image.Width = Largeur
        'Hauteur de l'image
        Image.Height = Hauteur
        'Est-ce que l'image doit se déplacer avec les cellules voici les 3 constantes possibles
        .Placement = xlFreeFloating 'or xlmove or xlMoveAndSize
        'Verrouillé ou pas
        .Locked = True 'or False
    End With
    Set Rg = Nothing
 End Sub

A+

Le fichier image ne se trouve pas dans le fichier excel mais dans ma sub j'appelais la fenêtre me permettant de sélectionner l'image.

J'ai adapté la macro précédente à mon besoin et ça marche nickel fgrand merci JExcel2fr

Bonjour JExceL2fr,

Comment intégrer vos macros images dans celle-ci pour que l'intégration de la photo choisi se fasse dans la cellule défini en changeant Feuil1 ezt le numéro de cellule ?

Merci beaucoup

<>Sub Photo1()
Dim PicList() As Variant
Dim PicFormat As String
Dim Rng As Range
Dim sShape As Shape
Dim pict As IPictureDisp, coeff As Double
On Error Resume Next
PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
xColIndex = Application.ActiveCell.Column
If IsArray(PicList) Then
xRowIndex = Application.ActiveCell.Row
For lLoop = LBound(PicList) To UBound(PicList)
Set Rng = Cells(xRowIndex, xColIndex)
Set pict = LoadPicture(PicList(lLoop))
coeff = pict.Width / pict.Height
Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), True, True, Rng.Left, Rng.Top, IIf(Rng.Width < Rng.Height, Rng.Width, Rng.Height * coeff), IIf(Rng.Width > Rng.Height, Rng.Height, Rng.Width / coeff))
xRowIndex = xRowIndex + 1
Next
End If
End Sub

Bonjour,

Vous avez un certain nombre d'outils au dessus de la boite de saisie des messages : Veuillez vous en servir.

Notamment celle qui permet d'insérer du code " </> " Appuyer sur l'outil avant d'insérer le code...

A+

 Sub Photo1()
    Dim PicList() As Variant
    Dim PicFormat As String
    Dim Rng As Range
    Dim sShape As Shape
    Dim pict As IPictureDisp, coeff As Double
    On Error Resume Next
    PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
    xColIndex = Application.ActiveCell.Column
    If IsArray(PicList) Then
        xRowIndex = Application.ActiveCell.Row
        For lLoop = LBound(PicList) To UBound(PicList)
            Set Rng = Cells(xRowIndex, xColIndex)
            Set pict = LoadPicture(PicList(lLoop))
              coeff = pict.Width / pict.Height
            Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), True, True, Rng.Left, Rng.Top, IIf(Rng.Width < Rng.Height, Rng.Width, Rng.Height * coeff), IIf(Rng.Width > Rng.Height, Rng.Height, Rng.Width / coeff))
            xRowIndex = xRowIndex + 1
        Next
    End If
End Sub

Je n'arrive pas à compiler vos macros et la mienne afin de n'en ai faire qu'une. Pourriez vous m'apporter votre expertise SVP car il ne me manque plus que celà.

Grand merci