selection hyperlinks() follow
Bonjour à tous,
J'ai un souci avec une macro réalisée avec l'enregistreur.
ça plante au niveau du selection.hyperlinks().follow
Quelqu'un pourrait-il m'aiguiller?
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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
| Sub BPA()
Dim R As Range
Dim Rlig As Integer
On Error Resume Next
Set R = Application.InputBox("Sélectionnez une plage !", "Sélection de cellules", Type:=8)
On Error GoTo 0
If Not R Is Nothing Then
selection.Hyperlinks(R.Value).Follow NewWindow:=False, AddHistory:=True
'ici j'ai une erreur 91 : variable objet ou bloc with non défini
Sheets("Devis").Select
Sheets("Devis").Copy After:=Sheets(1)
Sheets("Devis (2)").Select
Sheets("Devis (2)").Name = "BpA"
Range("J7:M9").Select
With selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = True
.ReadingOrder = xlContext
.MergeCells = False
End With
selection.Merge
Range("J10:M12").Select
With selection.Font
.Color = -16776961
.TintAndShade = 0
End With
Rlig = R.Row
ActiveCell.FormulaR1C1 = "Bon pour Accord"
Range("J7:M9").Select
ActiveCell.FormulaR1C1 = ThisWorkbook.Worksheets("CC2012").Cell(Rlig, 7).Value
Range("J7:M9").Select
selection.Borders(xlDiagonalDown).LineStyle = xlNone
selection.Borders(xlDiagonalUp).LineStyle = xlNone
selection.Borders(xlEdgeLeft).LineStyle = xlNone
selection.Borders(xlEdgeTop).LineStyle = xlNone
selection.Borders(xlEdgeBottom).LineStyle = xlNone
selection.Borders(xlEdgeRight).LineStyle = xlNone
selection.Borders(xlInsideVertical).LineStyle = xlNone
selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("J7:M12").Select
Range("J10").Activate
selection.Borders(xlDiagonalDown).LineStyle = xlNone
selection.Borders(xlDiagonalUp).LineStyle = xlNone
With selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
selection.Borders(xlInsideVertical).LineStyle = xlNone
selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("J10:M12").Select
selection.Borders(xlDiagonalDown).LineStyle = xlNone
selection.Borders(xlDiagonalUp).LineStyle = xlNone
With selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
selection.Borders(xlInsideVertical).LineStyle = xlNone
selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("L39").Select
ActiveWorkbook.Save
ActiveWindow.Close
Else
MsgBox "Aucune plage sélectionnée", vbCritical
End If
End Sub |
Merci d'avance
