[AC-2010] Liens trop long dans ma base.

[fab.85]

Bonjour,

dans ma base "Stock-Magasin" j'ai une liste d'article avec un emplacement prévu pour un lien qui permet de visualiser l'article, bien sur ce lien est trop long et lorsque j'exporte une liste d'article vers Excel cela déforme mon tableau..

comment faire pour que ce lien se réduise à la simple expression "Photo" par exemple??
un peu comme vous le faite dans vos réponses avec des redirections "ICI" ou"LA"

[LedZeppII]

Bonsoir,

J'ai jamais trouvé si on pouvait le faire simplement. Je me suis résolu à le faire par code.

Plutôt que d'expliquer, je vais donner un exemple.

J'ai une table tblLiensFAQ dans laquelle j'ai :

Code table :

1
2
3
4
5
6
Libelle                             LienHyptxt
---------------------------------   --------------------------------------------------------------------------------------
Erreur d'exécution '2164' '2165'    Erreur d'exécution '2164' '2165'#http://access.developpez.com/faq/?page=Bug#Err2164
Erreur d'exécution '3464'           Erreur d'exécution '3464'#http://access.developpez.com/faq/?page=Bug#Err3464
Erreur '429'                        Erreur '429'#http://access.developpez.com/faq/?page=Bug#CompActivex
Erreur '3033'                       Erreur 3033#http://access.developpez.com/faq/?page=Bug#err3033

LienHyptxt est un champ hypertexte.

Voici le code pour exporter cette table tblLiensFAQ, et recréer dans Excel les liens hypertextes.
(Il faut une référence VB à Microsoft Excel xx.x Object Library)

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
Sub ExportAvecLiensHyptxt()
Dim sObjToExport As String, sExportToFile As String
Dim xlApp As Excel.Application, bQuitXl As Boolean
Dim xlWbk As Excel.Workbook, xlSht As Excel.Worksheet
Dim rgCell As Excel.Range, rgHdrCell As Excel.Range
Dim lRowMax As Long, lRow As Long, lPos As Long
Dim sText As String, sDispl As String, sAddr As String
 
 
' Table à exporter
sObjToExport = "tblLiensFAQ"
' Fichier dans lequel exporter
sExportToFile = CurrentProject.Path & "\" & "Liens.xls"
' On supprime le fichier s'il existe
If Len(Dir(sExportToFile, vbNormal)) > 0 Then Kill sExportToFile
 
' Export dans fichier Excel
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
       sObjToExport, sExportToFile, True
 
' Ouvrir Excel
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
On Error GoTo 0
If xlApp Is Nothing Then
   Set xlApp = New Excel.Application
   bQuitXl = True
End If
 
' Ouvre le classeur
Set xlWbk = xlApp.Workbooks.Open(sExportToFile)
' référence la feuille active
Set xlSht = xlWbk.ActiveSheet
' Recherche la colonne "LienHyptxt"
Set rgHdrCell = xlSht.Rows(1).Find("LienHyptxt", , xlValues, xlWhole)
If Not (rgHdrCell Is Nothing) Then
   ' Dernière ligne dans la feuille
   lRowMax = xlSht.Cells.SpecialCells(xlCellTypeLastCell).Row
   ' Parcour les cellules de la colonne
   For lRow = 1 To lRowMax - 1
       ' Référence la cellule
       Set rgCell = rgHdrCell.Offset(lRow, 0)
       ' Texte de la cellule
       sText = rgCell.Text
       ' S'il y a un # venant d'un champ hypertexte Access
       lPos = InStr(1, sText, "#")
       If lPos > 0 Then
          ' Texte du lien
          sDispl = Left(sText, lPos - 1)
          ' Adresse du lien
          sAddr = Mid(sText, lPos + 1)
          ' Ajouter lien hypertexte dans la feuille
          ' à l'emplacement de la cellule référencée par rgCell
          xlSht.Hyperlinks.Add rgCell, sAddr, , sAddr, "Lien"
       End If
   Next
   ' Sauve le classeur
   xlWbk.Save
End If
 
' Libérer variables objets
Set xlSht = Nothing
xlWbk.Close
Set xlWbk = Nothing
If bQuitXl Then xlApp.Quit
Set xlApp = Nothing
 
End Sub

A+

[fab.85]

avec un peu de retard, merci pour ta réponse.