bonjour les gars
j'ai un tableau dans une feuille "recapdevis" qui se remplis par
hyperlink crée marche trés bien directement (en allant dans la feuile concernée et cliquer sur cellule(i;1)
j'ai crée un code qui me permet d'importer des données du fichier externe mentioné dans l'hyperlink pour les mettre dans ma 1ere feuille de mon fichier principale dans une listbox
si je ne ferme pas mon fichier l'importation marche très bien ,mais dés que je ferme le fichier en enregistrant bien sûr et je le rouvre ,ça me fait erreur 1004 alors que le fichier existe bel et bien dans le lien donné de l'hyperlink
j'ai un tableau dans une feuille "recapdevis" qui se remplis par
VB:
.Cells(ligne, 1) = Format(Sheets(feuilleactive).Range("D5").value, "000") 'n° DEVIS
.Hyperlinks.Add .Cells(ligne, 1), Ppath & "\" & PName & ".xlsx"
Code:
ph = RTrim(Left(Feuil1.Range("D2").value, 14))
Ppath = ActiveWorkbook.Path & "\" & "ProForma" & Year(Feuil1.Range("D4").value) & "\" & Format(ActiveSheet.Range("D5"), "000") & "-" & ph
Fpath = ActiveWorkbook.Path & "\" & "Facture" & Year(Feuil1.Range("D4").value) & "\" & Format(ActiveSheet.Range("G5"), "000") & "-" & ph
PName = ph & Format(Feuil1.Range("D4"), " dd" & "-mm" & "-yy") '& extension
FName = ph & Format(Feuil1.Range("G4"), " dd" & "-mm" & "-yy") '& extensionj'ai crée un code qui me permet d'importer des données du fichier externe mentioné dans l'hyperlink pour les mettre dans ma 1ere feuille de mon fichier principale dans une listbox
Code:
Private Sub CImport_Click()
Dim Ds As Worksheet, rg As Range, pk As String, l, num As Integer
Dim sFile As String, tWb, sWb As Workbook, tWs, sWs As Worksheet
If Me.importbox.ListIndex = -1 Then Exit Sub
num = importbox.ListIndex + 2
Set tWb = ThisWorkbook
Set tWs = tWb.Worksheets("Acceuil")
sFile = Feuil10.Range("A" & num).Hyperlinks(1).Address
'With Application.FileDialog(msoFileDialogFilePicker)
' If .Show = -1 Then
' sFile = .SelectedItems(1)
' End If
'End With
If sFile <> "" Then
Set sWb = Workbooks.Open(sFile)
DoEvents
Set sWs = sWb.Worksheets("Hanifatoys")
tWs.Range("B10:B196").value = sWs.Range("B14:B201").value 'désignation
tWs.Range("C10:C196").value = sWs.Range("D14:D201").value 'Qty
tWs.Range("D10:D196").value = sWs.Range("C14:C201").value 'Prix Unitaire
Set sWs = sWb.Worksheets("ATERNAL")
tWs.Range("E10:E196").value = sWs.Range("C14:C201").value 'désignation
Set sWs = sWb.Worksheets("Arba")
tWs.Range("F10:F196").value = sWs.Range("C14:C201").value 'désignation
sWb.Close False
Feuil1.Range("D2") = Feuil10.Cells(num, 3) 'client
Feuil1.Range("D4") = Feuil10.Cells(num, 2) 'Date
Feuil1.Range("D5") = Feuil10.Cells(num, 1) 'number facture
Feuil1.Range("G4") = "" 'facture
Feuil1.Range("H4") = "" 'BL
End If
End Sub
Dernière édition: