Inserer image WORD + lien hypertext pour ouvrir le document en .pdf ou .doc
Re,
J'ai des variables non définies quand:
je clique sur le bouton insertion "bouton5"
Private Sub CommandButton5_Click()
If ComboBox2.Value = "" Then
MsgBox "You must put a reference !"
Exit Sub
End If
Dim LastRow As Long
LastRow = ActiveWorkbook.Sheets("DATABASE_VUSHF").Range("A1000000").End(xlUp).Row
LastRow = LastRow + 1
With ActiveWorkbook.Sheets("DATABASE_VUSHF")
For i = 1 To 26
.Cells(LastRow, i).Value = Controls("ComboBox" & i).Value
Next i
.Range("AA" & LastRow).Value = TextBox26.Value
.Range("AB" & LastRow).Value = TextBox27.Value
.Range("AC" & LastRow).Value = TextBox28.Value
.Range("AD" & LastRow).Value = TextBox29.Value
.Range("AE" & LastRow).Value = TextBox30.Value
MsgBox "Your reference has been added!"
End With
Unload Me
MODEMIDENTIFICATION.show
UserForm_Initialize
End SubPrivate Sub CommandButton5_Click()
For i = 1 To 26
J'ai fait une correction en ajoutant cette variable:
Option Explicit
Dim TblBD()
Dim dchoisis1, dchoisis2, dchoisis3, dchoisis4, dchoisis5, dchoisis6, dchoisis7, dchoisis8, dchoisis9, dchoisis10, dchoisis11, dchoisis12, dchoisis13, dchoisis14, dchoisis15, dchoisis16
Dim nomtableau As String
Dim nbcol As Byte
Dim i As ByteDim i As Byte
Apres ce correctif tout semble fonctionner !
Re,
J'ai aussi enlever les messages box des commandes bouton de 10/11/12/13.
Sur ma vraie DATABASE, a chaque fois que je cliquais sur une ligne il me renvoyait le messagebox. ("MsgBox "delete done!")
Private Sub CommandButton10_Click()
Image1.Picture = LoadPicture("")
TextBox27 = vbNullString
End Sub
Private Sub CommandButton11_Click()
Image2.Picture = LoadPicture("")
TextBox28 = vbNullString
End Sub
Private Sub CommandButton12_Click()
Image3.Picture = LoadPicture("")
TextBox29 = vbNullString
End Sub
Private Sub CommandButton13_Click()
Image4.Picture = LoadPicture("")
TextBox30 = vbNullString
End SubTout est fonctionnel sauf pour le fameux problème de l'image4.
A+
Dan,
Je souhaite adapter ce code pour la commande bouton 5 "insertion".
Private Sub CommandButton5_Click()
With Sheets("DATABASE_VUSHF").Range("Tableau1").ListObject
If .ListRows.Count > 0 Then
With .DataBodyRange.Cells(.ListRows.Count, 1)
s = Left(.Value, 2) & Format(Mid(.Value, 3, 5) + 1, "00000") & "-1"
End With
With .ListRows.Add.Range
.Range("A1").Value = s 'nouvelle numéro en A1
.Range("AA1").Resize(, 5).Value = Array(TextBox26.Value, TextBox27.Value, TextBox28.Value, TextBox29.Value, TextBox30.Value) 'ces 5 textboxes en AA:AE
End With
Else
MsgBox "problème, c'est la premiere ligne"
End If
End With
Unload Me
MODEMIDENTIFICATION.show
UserForm_Initialize
End SubJe souhaite adapter ce code pour la commande bouton 14 "insertion". (que vous n'avez pas)
Private Sub CommandButton14_Click()
Dim LO
Set LO = Sheets("DATABASE_VUSHF").Range("Tableau1").ListObject 'ce tableau
With ComboBox1
'Debug.Print .Text
If .Text = "" Then Exit Sub 'si vide, arrête
r = Application.Match(.Text, LO.ListColumns("ELECTRONIC NAME").DataBodyRange, 0) 'ligne du tableau où ce nom se trouve
If Not IsNumeric(r) Then MsgBox "introuvable !!!???": Exit Sub 'normallement ceci serait impossible
s = Left(.Value, 8) & Split(.Value, "-")(1) + 1 ' "electronic name" suivant
r1 = Application.Match(s, LO.ListColumns("ELECTRONIC NAME").DataBodyRange, 0) 'rechercher ce nouveau electronic name
If IsNumeric(r1) Then MsgBox "cet ""Electronic Name"" existe déjà !!!", vbCritical, s: Exit Sub 'existe déjà = arrête
End With
Set c = LO.ListRows.Add(r + 1).Range 'insérer une nouvelle ligne après la ligne actuelle
c.Value = c.Offset(-1).Value 'copier et coller les données de l'ancienne ligne >>>> je ne suis pas sû que je peux faire cela, c'est plutôt un exemple
c.Cells(1).Value = s 'seulement l' "Electronic Name" est différent
Unload Me 'votre système de mise à jour
MODEMIDENTIFICATION.show
UserForm_Initialize
End SubIl faut que je definisse la variable "s" dans explicit.
Pouvez-vous m'aider ?
a+
Bonjour
J'ai un bug avec l'image 4.
Ajoutez cette ligne juste en dessous de Dim chemin
If TextBox30.Value = vbNullString Then Exit SubJ'ai des variables non définies quand:je clique sur le bouton insertion "bouton5"
Vous allez trop vite là. Je vous ai dit que j'avais d'autres choses à vous donner
1. Enlever la déclaration Dim i as byte que vous avez ajoutée au dessus des codes
2. Remplacez votre code par celui ci-dessous
Private Sub CommandButton5_Click()
If ComboBox2.Value = "" Then
MsgBox "You must choose a reference in the combobox identification !", vbCritical, "Reference manquante"
Exit Sub
End If
Dim lastRow As Long
Dim i As Byte
With Worksheets("DATABASE").ListObjects(1)
If .ListRows.Count = 0 Then
.ListRows.Add: lastRow = 1
Else: .ListRows.Add: lastRow = .ListRows.Count
End If
With .DataBodyRange
For i = 1 To 26
.Item(lastRow, i) = ComboBox1.Value
Next i
For i = 27 To 31
.Item(lastRow, i) = Controls("Textbox" & i - 1)
Next i
End With
MsgBox "Your reference has been added!"
End With
Call reset_all_controls
End Sub3. Supprimez votre macro "Function reset_all_controls()" et remplacez là par ceci
Sub reset_all_controls()
Dim ctl As MSForms.Control
For Each ctl In Me.Controls
Select Case TypeName(ctl)
Case "TextBox"
ctl.Text = ""
Case "CheckBox"', "OptionButton", "ToggleButton"
ctl.Value = False
Case "ComboBox", "ListBox"
ctl.ListIndex = -1
End Select
Next ctl
End SubJ'ai aussi enlever les messages box des commandes bouton de 10/11/12/13.
Ben ce n'était pas dans les codes que je vous ai donnés
Je verrai après test pour le reste
Re,
Oui excusez moi, je voulais, souhaitais vous faire partager les codes insertions.
Pour l'image4_click(), le bug est toujours present malgré le correctif.
Private Sub Image4_click()
Dim slash As String
Dim chemin
If TextBox30.Value = vbNullString Then Exit Sub
slash = InStrRev(TextBox30.Value, "\")
chemin = Left(TextBox30.Value, slash - 1)
If Dir(chemin, vbDirectory) <> "" Then
Shell "explorer.exe /e," & chemin, vbNormalFocus
End If
End SubA+
Pour l'image4_click(), le bug est toujours present malgré le correctif.
Dingue cela, je n'ai rien comme problème
La textbox30 contient quoi comme info ?
Avant la ligne chemin =..... mettez cette ligne
msgbox Left(TextBox30.Value, slash - 1)Cela vous renvoie quoi ?
La textbox30 contient une information comme TECHNICAL36 OU ..... , et si je clique dessus message d'erreur.
J'ai applique le correctif: mais j'ai le bug avec cette ligne
MsgBox Left(TextBox30.Value, slash - 1)
Private Sub Image4_click()
Dim slash As String
Dim chemin
If TextBox30.Value = vbNullString Then Exit Sub
slash = InStrRev(TextBox30.Value, "\")
MsgBox Left(TextBox30.Value, slash - 1)
chemin = Left(TextBox30.Value, slash - 1)
If Dir(chemin, vbDirectory) <> "" Then
Shell "explorer.exe /e," & chemin, vbNormalFocus
End If
End SubJe vais faire avec des cases vides cela doit être ca le problème
a+
Problème règle, il ne fallait rien dans la case textbox30.
La textbox30 contient une information comme TECHNICAL36 OU ..... , et si je clique dessus message d'erreur.
ouf fallait le deviner votre problème !
Le bug est normal puisque ce n'est pas un répertoire que vous avez dans la textbox
Je me demande pourquoi vous mettez cette info (tableau36) dans votre tableau au lieu de laisser les lignes vides non ?
Sinon juste avant la ligne Slash = ...., mettez cette ligne --> ON ERROR RESUME NEXT
Edit : d'ailleurs en y repensant vous devriez mettre la propriété "locked" des 4 textbox sur TRUE de manière à ce que personne ne modifie ce qui est importé de la feuille Database
Oui, je faisais des essais insertion, modification suppression pour voir si tout fonctionnait.
dsl
Pour les locked, c'est ce que j'ai fait sur ma vraie database, merci pour votre soutien.
Ok. je suppose que vous avez fait les modif bouton 5 --> https://forum.excel-pratique.com/s/goto/1162858
Bon je passe au bouton DELETE
1. Remplacez ce code
Private Sub CommandButton9_Click()
Call delete_from_form_with_confirmation
End Sub2. Remplacez la macro Function delete_from_form_with_confirmation par ceci
Sub delete_from_form_with_confirmation()
Dim answer As Integer, ligne As Integer
Dim TS As ListObject
Set TS = Sheets("DATABASE").ListObjects(1)
ligne = WorksheetFunction.Match(ListBox20.List(ListBox20.ListIndex, 0), TS.ListColumns(1).DataBodyRange, 0)
answer = MsgBox("Delete row " & ligne & " from Data", vbQuestion + vbYesNo + vbDefaultButton2, "Confirmation")
If answer = vbYes Then
TS.ListRows(ligne).Range.Delete
Me.ListBox20.RemoveItem (Me.ListBox20.ListIndex)
End If
End SubFaites un test
Pour DELETE tout est ok.
Pour le bouton 5, j'ai laisse cela car j'avais un bug avec votre code sur le formulaire.
Private Sub CommandButton5_Click()
If ComboBox2.Value = "" Then
MsgBox "You must put a reference !"
Exit Sub
End If
Dim LastRow As Long
LastRow = ActiveWorkbook.Sheets("DATABASE_VUSHF").Range("A1000000").End(xlUp).Row
LastRow = LastRow + 1
With ActiveWorkbook.Sheets("DATABASE_VUSHF")
For i = 1 To 26
.Cells(LastRow, i).Value = Controls("ComboBox" & i).Value
Next i
.Range("AA" & LastRow).Value = TextBox26.Value
.Range("AB" & LastRow).Value = TextBox27.Value
.Range("AC" & LastRow).Value = TextBox28.Value
.Range("AD" & LastRow).Value = TextBox29.Value
.Range("AE" & LastRow).Value = TextBox30.Value
MsgBox "Your reference has been added!"
End With
Unload Me
MODEMIDENTIFICATION.show
UserForm_Initialize
End Subla textbox 26 n'etant pas pris en compte avec votre code.
J'ai essaye d'appliquer votre code en changeant:
Next i
For i = 26 To 31
.Item(lastRow, i) = Controls("Textbox" & i - 1)
Next i
End Withmais j'ai un bug
.Item(lastRow, i) = Controls("Textbox" & i - 1)
Votre code n'est pas adapté au tableau structuré. Là vous avez un code comme on faisait lorsque les tableaux structurés n'existaient pas
Si vous mettez for i = 26 to 31, ce n'est pas correct
Mettez for i = 28 to 31
Pour comprendre le code For i = 28 to 31
.Item(lastRow, i) --> i correspond à la colonne 28 à 31 (colonne AB à AE)
Controls("Textbox" & i - 1) --> lorsque i vaut 28 prend les données de la textbox27
exemple avec i =28 --> .Item(lastRow, 28) = Controls("Textbox" & 27)
J'ai applique les changements
Private Sub CommandButton5_Click()
If ComboBox2.Value = "" Then
MsgBox "You must choose a reference in the combobox identification !", vbCritical, "Reference manquante"
Exit Sub
End If
Dim lastRow As Long
Dim i As Byte
With Worksheets("DATABASE_VUSHF").ListObjects(1)
If .ListRows.Count = 0 Then
.ListRows.Add: lastRow = 1
Else: .ListRows.Add: lastRow = .ListRows.Count
End If
With .DataBodyRange
For i = 1 To 26
.Item(lastRow, i) = ComboBox1.Value
Next i
For i = 28 To 31
.Item(lastRow, i) = Controls("Textbox" & i - 1)
Next i
End With
MsgBox "Your reference has been added!"
End With
Call reset_all_controls
End SubPas de bug certes !
Mais j'ai tous les champs qui prennent la valeur de la ComboBox1 (AA00035-1) de la Combobox2 a 26.
La valeur dans la TextBox26 n'apparait plus.
pour voir la nouvelle insertion, je suis obliger de fermer le formulaire et le réouvrir.
Seules les images de 1 a 4 sont prises en compte avec le bouton l'insertion.
J'ai remarque d'autres bugs concernant les images.
Quand je clique sur n'importe quelles images de 1 a 4 qu il y ait une image ou non, un chemin textbox ou non, les images clickees sont conservées sur n'importe quelles lignes que je sélectionne dans la ListBox20.
Mais j'ai tous les champs qui prennent la valeur de la ComboBox1 (AA00035-1) de la Combobox2 a 26.
Exact. Là c'est de ma faute
il faut remplacer .Item(lastRow, i) = ComboBox1.Value par ceci
.Item(lastRow, i) = Controls("ComboBox" & i).ValueLa valeur dans la TextBox26 n'apparait plus.
Remplacez le 28 par 27 dans la boucle for i = 28 to 31
pour voir la nouvelle insertion, je suis obliger de fermer le formulaire et le réouvrir.
Testez en rajoutant ceci juste avant le END SUB
UserForm_InitializeDésolé mais je ne suis pas en situation réelle devant votre vrai fichier....
C'est ok pour le code de la CommandButton5_Click ()
Je pense que vous souhaitez que l'on fasse cela après, c'etait d'integrer dans ce bouton le code avec un identifiant automatique.
Ok mais c'est quel code cela ?
vous l'avez mis dans un post de ce fil ?
On me l'a donne sur un autre fil et je le trouve bien 1
Le bouton insertion numéro 5 me crée une nouvelle ligne a partir du dernier identifiant incrémenté de +1.
Apres je sélectionne la ligne créée pour y mettre mes valeurs dans chaque champs et appuyer sur le bouton modifier pour les intégrer.
Voici le code:
Private Sub CommandButton5_Click()
With Sheets("DATABASE_VUSHF").Range("Tableau1").ListObject
If .ListRows.Count > 0 Then
With .DataBodyRange.Cells(.ListRows.Count, 1)
s = Left(.Value, 2) & Format(Mid(.Value, 3, 5) + 1, "00000") & "-1"
End With
With .ListRows.Add.Range
.Range("A1").Value = s 'nouvelle numéro en A1
.Range("AA1").Resize(, 5).Value = Array(TextBox26.Value, TextBox27.Value, TextBox28.Value, TextBox29.Value, TextBox30.Value) 'ces 5 textboxes en AA:AE
End With
Else
MsgBox "problème, c'est la premiere ligne"
End If
End With
Unload Me
MODEMIDENTIFICATION.show
UserForm_Initialize
End SubApres je vais créer un autre bouton insertion, le numéro 14, qui va me générer un identifiant a partir de la selection de n'importe quelle ligne de la LISTBOX20 afin d'avoir un nouveau mode de fonctionnement du système
tel que AA00033-1 / AA00033-2 / AA00033-3 ...
Private Sub CommandButton14_Click()
Dim LO
Set LO = Sheets("DATABASE_VUSHF").Range("Tableau1").ListObject 'ce tableau
With ComboBox1
'Debug.Print .Text
If .Text = "" Then Exit Sub 'si vide, arrête
r = Application.Match(.Text, LO.ListColumns("ELECTRONIC NAME").DataBodyRange, 0) 'ligne du tableau où ce nom se trouve
If Not IsNumeric(r) Then MsgBox "introuvable !!!???": Exit Sub 'normallement ceci serait impossible
s = Left(.Value, 8) & Split(.Value, "-")(1) + 1 ' "electronic name" suivant
r1 = Application.Match(s, LO.ListColumns("ELECTRONIC NAME").DataBodyRange, 0) 'rechercher ce nouveau electronic name
If IsNumeric(r1) Then MsgBox "cet ""Electronic Name"" existe déjà !!!", vbCritical, s: Exit Sub 'existe déjà = arrête
End With
Set c = LO.ListRows.Add(r + 1).Range 'insérer une nouvelle ligne après la ligne actuelle
c.Value = c.Offset(-1).Value 'copier et coller les données de l'ancienne ligne >>>> je ne suis pas sû que je peux faire cela, c'est plutôt un exemple
c.Cells(1).Value = s 'seulement l' "Electronic Name" est différent
Unload Me 'votre système de mise à jour
MODEMIDENTIFICATION.show
UserForm_Initialize
End SubA+