Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
2683 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Module/ UserForm/ Excel VBA

 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

Module/ UserForm/ Excel VBA

n°2221949
irwinurpo
Posté le 10-03-2014 à 11:40:54  profilanswer
 

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
mood
Publicité
Posté le 10-03-2014 à 11:40:54  profilanswer
 


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Module/ UserForm/ Excel VBA

 

Sujets relatifs
Macro pour faire un calendrier excel[VBA] Donner une valeur numérique à une chaine de caractère
Suppression de RDV dans Outlook via macro ExcelRemplir plusieurs feuilles Excel
Problème de tableau excelExo VBA
Macro - Fonctions VBArechercher remplacer en VB sur excel
[VBA] Envoyer SMS API OVHBesoin d'aide pour fichier gestion absence en VBA
Plus de sujets relatifs à : Module/ UserForm/ Excel VBA


Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR