Module/ UserForm/ Excel VBA

Module/ UserForm/ Excel VBA - VB/VBA/VBS - Programmation

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
Reply

Marsh Posté le 10-03-2014 à 11:40:54   

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed