【问题标题】:How to create a hyperlink with a userform ? VBA如何使用用户表单创建超链接? VBA
【发布时间】:2021-08-31 15:33:41
【问题描述】:

我在很多帮助下创建了一个代码,该代码与用户一起创建了一个包含客户名称和许多其他信息的新工作表。在恢复所有名称客户端的第一页中,我创建了一个超链接(C 列),该超链接发送到客户端的队列名称。但是使用用户窗体会出现错误 424。

 Private Sub btnajoutclient_Click()

Dim numFeuilClient As String
Dim prenomFeuilClient As String
Dim telFeuilClient As String
Dim mailFeuilClient As String
Dim AdresseFeuilClient As String
Dim cpFeuilClient As String
Dim villeFeuilClient As String
 'RENDRE LES FEUILLES VISIBLES'
Worksheets(2).Visible = True
Worksheets(3).Visible = True
 'CREER 2 BOITES POUR AVOIR LES INFOS : NOM ET TEL'
numFeuilClient = frmnouveauclient.TextBoxcasenom
prenomFeuilClient = frmnouveauclient.TextBoxprénom
telFeuilClient = frmnouveauclient.TextBoxcasenumérotel
mailFeuilClient = frmnouveauclient.TextBoxcasemail
AdresseFeuilClient = frmnouveauclient.TextBoxcaseadresse
cpFeuilClient = frmnouveauclient.TextBoxcasecodepostal
villeFeuilClient = frmnouveauclient.TextBoxcaseville   
 'freezer lécran
Application.ScreenUpdating = False
'SI PAS DE NOM SAISIE ALORS EXIT'
If numFeuilClient = "" Then
 Worksheets(2).Visible = False
 Worksheets(3).Visible = False
 Exit Sub
End If
'ON SUPPRIME LA ZONE SELECTIONNER LA FEUILLE TYPE'
Sheets("FeuilClient").Range("_zonesuprfinal").ClearContents
Sheets("FeuilClient").Copy after:=Sheets(Sheets.Count)
'RENOMMER LA FEUILLE
   ActiveSheet.Name = numFeuilClient
'ON MET LE NOM ET LE TEL DANS LES CASES SELECTIONEE DE LA FEUILLE CLIENT'
ActiveSheet.Range("_nomclient").Value = numFeuilClient
ActiveSheet.Range("_telclient").Value = telFeuilClient
ActiveSheet.Range("_prenomclient").Value = prenomFeuilClient
ActiveSheet.Range("_mailclient").Value = mailFeuilClient
ActiveSheet.Range("_adresse").Value = AdresseFeuilClient
ActiveSheet.Range("_codepostal").Value = cpFeuilClient
ActiveSheet.Range("_ville").Value = villeFeuilClient
'Aller sur la feuille fichier client
Sheets(1).Activate
'On trouve une case vide et y met le nom sur le fichier client
Feuil3.Range("A1048000").Select
ActiveCell.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = numFeuilClient
'On trouve une case vide et y met le nom sur le tel du client
Sheets("FichierClient").Range("B1048000").Select
ActiveCell.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = telFeuilClient
'Mettre un hyperlien sur le fichierclient
Sheets("FichierClient").Range("C1048000").Select
ActiveCell.End(xlUp).Select
ActiveCell.Offset(1, 0).Select




Hyperlinks.Add Anchor:=ActiveCell, Address:="", _
     SubAddress:="'" & numFeuilClient & "'!A1", TextToDisplay:="Voir Client"



 'ON REND INSIVIBLE LES FEUILLES'
  Worksheets(2).Visible = False
 Worksheets(3).Visible = False
'défreezer l'écran
  Application.ScreenUpdating = True
End Sub

【问题讨论】:

  • 如果您有一个问题,我们为什么要查看您的所有代码?此错误表示您没有设置特定对象。您向我们展示了很多(无用的)代码,并且没有指定错误出现在哪一行...我们猜是 Shell?
  • 感谢您的回答。我显示所有代码,因为我不知道问题出在哪里。而且我想更容易理解代码并解决它来见他。
  • 至少,这个错误什么时候出现?您是否尝试过逐行运行代码(使用 F8)并查看代码在哪一行停止?
  • 是的,这是代码末尾带有超链接的行。他不能放置工作表的超链接:Sheets("FichierClient").Range("C1048000").Select ActiveCell.End(xlUp).Select ActiveCell.Offset(1, 0).Select Hyperlinks.Add Anchor:= ActiveCell, Address:="", _ SubAddress:="'" & numFeuilClient & "'!A1", TextToDisplay:="Voir Client"

标签: excel vba excel-formula hyperlink excel-2019


【解决方案1】:

Hyperlinks 需要限定为Worksheet

简单的解决方法是将其更改为

ActiveSheet.HyperLinks.Add ...

也就是说,有很多机会可以改进此代码。考虑一下这个

Private Sub btnajoutclient_Click()
    Dim numFeuilClient As String
    Dim prenomFeuilClient As String
    Dim telFeuilClient As String
    Dim mailFeuilClient As String
    Dim AdresseFeuilClient As String
    Dim cpFeuilClient As String
    Dim villeFeuilClient As String
    Dim wsFeuilClient As Worksheet

    With ThisWorkbook ' or ActiveWorkbook or specify a workbook
        'RENDRE LES FEUILLES VISIBLES'
        .Worksheets(2).Visible = True
        .Worksheets(3).Visible = True

         'CREER 2 BOITES POUR AVOIR LES INFOS : NOM ET TEL'
        With frmnouveauclient
            numFeuilClient = .TextBoxcasenom
            'SI PAS DE NOM SAISIE ALORS EXIT'
            If numFeuilClient = vbNullString Then
                GoTo CleanUp
            End If

            prenomFeuilClient = .TextBoxprénom
            telFeuilClient = .TextBoxcasenumérotel
            mailFeuilClient = .TextBoxcasemail
            AdresseFeuilClient = .TextBoxcaseadresse
            cpFeuilClient = .TextBoxcasecodepostal
            villeFeuilClient = .TextBoxcaseville
        End With

        'freezer lécran
        Application.ScreenUpdating = False

        'ON SUPPRIME LA ZONE SELECTIONNER LA FEUILLE TYPE'
        .Worksheets("FeuilClient").Range("_zonesuprfinal").ClearContents
        Set wsFeuilClient = .Worksheets("FeuilClient").Copy(after:=.Sheets(.Sheets.Count))

        'RENOMMER LA FEUILLE
        With wsFeuilClient
            .Name = numFeuilClient

        'ON MET LE NOM ET LE TEL DANS LES CASES SELECTIONEE DE LA FEUILLE CLIENT'
            .Range("_nomclient").Value = numFeuilClient
            .Range("_telclient").Value = telFeuilClient
            .Range("_prenomclient").Value = prenomFeuilClient
            .Range("_mailclient").Value = mailFeuilClient
            .Range("_adresse").Value = AdresseFeuilClient
            .Range("_codepostal").Value = cpFeuilClient
            .Range("_ville").Value = villeFeuilClient
        End With

        'Aller sur la feuille fichier client
        With .Sheets(1)
            'On trouve une case vide et y met le nom sur le fichier client
            .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = numFeuilClient
        End With
        With .Worksheets("FichierClient")
            'On trouve une case vide et y met le nom sur le tel du client
            .Cells(.Rows.Count, 2).End(xlUp).Offset(1, 0).Value = numFeuilClient
            'Mettre un hyperlien sur le fichierclient
            With .Cells(.Rows.Count, 3).End(xlUp).Offset(1, 0)
                .Value = numFeuilClient

                .Worksheet.Hyperlinks.Add Anchor:=.Cells, Address:=vbNullString, _
                    SubAddress:="'" & numFeuilClient & "'!A1", TextToDisplay:="Voir Client"
            End With
        End With

CleanUp:
        'ON REND INSIVIBLE LES FEUILLES'
        .Worksheets(2).Visible = False
        .Worksheets(3).Visible = False
    End With

    'défreezer l'écran
    Application.ScreenUpdating = True
End Sub

【讨论】:

  • 谢谢你的回答,我会看到的。
猜你喜欢
  • 2013-10-24
  • 2018-03-09
  • 2014-12-10
  • 1970-01-01
  • 1970-01-01
  • 2014-01-18
  • 1970-01-01
  • 1970-01-01
  • 2017-08-19
相关资源
最近更新 更多