Je viens de bien créé un fichier Excel avec le code VBA pour ouvrir des fichiers (type .doc/ .xsl/ .pdf) avec différentes références!! Les 3 référeces sont dans une feuille "Nomenclature" et dans un table d'auto rémplisage. Il ya une autre feuille pour changer l'addresse de déstination "Paramétrage" et ca marche très bien mais, c'est toujours la même addresse; Alors, c'est-là où j'ai le souci!! J'arrive pas aller à différents addresses pour ouvrir les fichiers, j'ai changé déjà le code de références de la feullie de "Paramétrage" pour aller dans la auto-table dans la fauille "Nomenclature" mais, ca marche pas!! (Tout ca marche avec une module) Donc, si quelq'un peut m'aider je serai vraiment remercie avec vous...
Merci par votre attention et bonne journée
------------------------------------------------------------------------ Voila le code de la feuille "Nomenclature ------------------------------------------------------------------------- Option Explicit Sub MAJ(Rep As Integer) Dim Cel As Range Dim Reference As String Dim Chemin As String Dim Verif As String
If Verif = "" Then MsgBox ("Aucune photo n'est associée à cet article" ) Exit Sub Else UserForm1.Height = 600 UserForm1.Image1.Picture = LoadPicture(Chemin) End If
If Verif = "" Then MsgBox ("Aucune plan n'est associée à cet article" ) Exit Sub Else UserForm3.WebBrowser1.Navigate Chemin UserForm3.Show End If
End Select End Sub -------------------------------------AutoRémplisageTable------------------------------------------ Private Sub UserForm_Activate() Dim TotErr As Integer
----------------------------------------------------------------------------------------------------- Voila le code de la feuille "Paramétrage". ----------------------Macro qui permet de mofifier le chemin de mon dossier photo--------------------- Private Sub Cmd_CheminPhoto_Click() Dim Fenetre As String
Fenetre = Application.GetOpenFilename _ (FileFilter:="Tous les fichiers (*.*),*.* ", Title:="Sélectionnez un fichier" )
If Left(Fenetre, InStrRev(Fenetre, "\", -1)) = "" Then MsgBox ("Le chemin du répertoire photo est resté identique" ) Exit Sub Else Sheets("Nomenclature" ).Range("F14" ).Value = Left(Fenetre, InStrRev(Fenetre, "\", -1)) UserForm4.Hide MsgBox ("Le Chemin a bien été modifié" ) End If
End Sub
'-----------------Macro qui permet de mofifier le chemin de mon dossier plan--------------- Private Sub Cmd_CheminPlan_Click()
Dim Fenetre As String
Fenetre = Application.GetOpenFilename _ (FileFilter:="Tous les fichiers (*.*),*.* ", _ Title:="Sélectionnez un fichier" )
If Left(Fenetre, InStrRev(Fenetre, "\", -1)) = "" Then MsgBox ("Le chemin du répertoire plan est resté identique" ) Exit Sub Else Sheets("Nomenclature" ).Range("F14" ).Value = Left(Fenetre, InStrRev(Fenetre, "\", -1)) UserForm4.Hide MsgBox ("Le Chemin a bien été modifié" ) End If ----------------------------------------------------------------------------------------------------
Message édité par irwinurpo le 11-03-2014 à 10:46:35
Marsh Posté le 10-03-2014 à 11:40:54
Bonjour!!
Je viens de bien créé un fichier Excel avec le code VBA pour ouvrir des fichiers (type .doc/ .xsl/ .pdf) avec différentes références!! Les 3 référeces sont dans une feuille "Nomenclature" et dans un table d'auto rémplisage. Il ya une autre feuille pour changer l'addresse de déstination "Paramétrage" et ca marche très bien mais, c'est toujours la même addresse; Alors, c'est-là où j'ai le souci!! J'arrive pas aller à différents addresses pour ouvrir les fichiers, j'ai changé déjà le code de références de la feullie de "Paramétrage" pour aller dans la auto-table dans la fauille "Nomenclature" mais, ca marche pas!! (Tout ca marche avec une module) Donc, si quelq'un peut m'aider je serai vraiment remercie avec vous...
Merci par votre attention et bonne journée
------------------------------------------------------------------------
Voila le code de la feuille "Nomenclature
-------------------------------------------------------------------------
Option Explicit
Sub MAJ(Rep As Integer)
Dim Cel As Range
Dim Reference As String
Dim Chemin As String
Dim Verif As String
Select Case Rep
Case 1 'Chemin Photo
Reference = Sheets("Nomenclature" ).Range("D14", Sheets("Nomenclature" ).Cells(Rows.Count, "D" ).End(xlUp)).SpecialCells(xlCellTypeVisible).Value
Chemin = Sheets("Nomenclature" ).Range("F14" ).Value & Reference & ".jpg"
Verif = Dir(Chemin)
If Verif = "" Then
MsgBox ("Aucune photo n'est associée à cet article" )
Exit Sub
Else
UserForm1.Height = 600
UserForm1.Image1.Picture = LoadPicture(Chemin)
End If
Case 2 'Chemin Doc 1
Reference = Sheets("Nomenclature" ).Range("E14", Sheets("Nomenclature" ).Cells(Rows.Count, "E" ).End(xlUp)).SpecialCells(xlCellTypeVisible).Value
Chemin = Sheets("Nomenclature" ).Range("F14" ).Value & Reference & ".doc"
Verif = Dir(Chemin)
If Verif = "" Then
MsgBox ("Aucune plan n'est associée à cet article" )
Exit Sub
Else
UserForm3.WebBrowser1.Navigate Chemin
UserForm3.Show
End If
Case 3 'Chemin Doc 2
Reference = Sheets("Nomenclature" ).Range("E14", Sheets("Nomenclature" ).Cells(Rows.Count, "E" ).End(xlUp)).SpecialCells(xlCellTypeVisible).Value
Chemin = Sheets("Paramétrage" ).Range("F14" ).Value & Reference & ".pdf"
Verif = Dir(Chemin)
If Verif = "" Then
MsgBox ("Aucune plan n'est associée à cet article" )
Exit Sub
Else
UserForm3.WebBrowser1.Navigate Chemin
UserForm3.Show
End If
End Select
End Sub
-------------------------------------AutoRémplisageTable------------------------------------------
Private Sub UserForm_Activate()
Dim TotErr As Integer
Sheets("Nomenclature" ).Range("D14" ).AutoFilter
Sheets("Nomenclature" ).Range("D14" ).AutoFilter Field:=1, Criteria1:=Val_F
Sheets("Nomenclature" ).Range("D14" ).AutoFilter Field:=2, Criteria1:=Val_C
TotErr = Sheets("Nomenclature" ).AutoFilter.Range.Columns(4).SpecialCells(xlCellTypeVisible).Cells.Count
If TotErr = 1 Then
UserForm1.Hide
MsgBox ("Cette référence n'est pas présente dans la nomenclature" )
Exit Sub
Else
UserForm1.Height = 120
Me.Text10 = Sheets("Nomenclature" ).Range("D13" ) & " : "
Me.Text11 = Sheets("Nomenclature" ).Range("D14", Sheets("Nomenclature" ).Cells(Rows.Count, "D" ).End(xlUp)).SpecialCells(xlCellTypeVisible).Value
Me.Text12 = Sheets("Nomenclature" ).Range("E13" ) & " : "
Me.Text13 = Sheets("Nomenclature" ).Range("E14", Sheets("Nomenclature" ).Cells(Rows.Count, "E" ).End(xlUp)).SpecialCells(xlCellTypeVisible).Value
Me.Text14 = Sheets("Nomenclature" ).Range("C13" ) & " : "
Me.Text15 = Sheets("Nomenclature" ).Range("C14", Sheets("Nomenclature" ).Cells(Rows.Count, "C" ).End(xlUp)).SpecialCells(xlCellTypeVisible).Value
Me.Text16 = Sheets("Nomenclature" ).Range("F13" ) & " : "
Me.Text17 = Sheets("Nomenclature" ).Range("F14", Sheets("Nomenclature" ).Cells(Rows.Count, "F" ).End(xlUp)).SpecialCells(xlCellTypeVisible).Value
End If
End Sub
-----------------------------------------------------------------------------------------------------
Voila le code de la feuille "Paramétrage".
----------------------Macro qui permet de mofifier le chemin de mon dossier photo---------------------
Private Sub Cmd_CheminPhoto_Click()
Dim Fenetre As String
Fenetre = Application.GetOpenFilename _
(FileFilter:="Tous les fichiers (*.*),*.* ", Title:="Sélectionnez un fichier" )
If Left(Fenetre, InStrRev(Fenetre, "\", -1)) = "" Then
MsgBox ("Le chemin du répertoire photo est resté identique" )
Exit Sub
Else
Sheets("Nomenclature" ).Range("F14" ).Value = Left(Fenetre, InStrRev(Fenetre, "\", -1))
UserForm4.Hide
MsgBox ("Le Chemin a bien été modifié" )
End If
End Sub
'-----------------Macro qui permet de mofifier le chemin de mon dossier plan---------------
Private Sub Cmd_CheminPlan_Click()
Dim Fenetre As String
Fenetre = Application.GetOpenFilename _
(FileFilter:="Tous les fichiers (*.*),*.* ", _
Title:="Sélectionnez un fichier" )
If Left(Fenetre, InStrRev(Fenetre, "\", -1)) = "" Then
MsgBox ("Le chemin du répertoire plan est resté identique" )
Exit Sub
Else
Sheets("Nomenclature" ).Range("F14" ).Value = Left(Fenetre, InStrRev(Fenetre, "\", -1))
UserForm4.Hide
MsgBox ("Le Chemin a bien été modifié" )
End If
----------------------------------------------------------------------------------------------------
Message édité par irwinurpo le 11-03-2014 à 10:46:35