İki ayrı kodu aynı sayfada çalıştırmam gerekiyor

[tahsinanarat]

Aşağıdaki kodlar aynı sayfanın kod bölümünde olması gerekiyor,ancak çalıştırırken hata alıyorum, ikisini bir arada nasıl kullanabilirim. Saygılarımla

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.CutCopyMode = xlCopy Then Exit Sub
If Application.CutCopyMode = xlCut Then Exit Sub
On Error Resume Next
If Intersect(Target, [B:B]) Is Nothing Then GoTo son
If Target.Address = "$B$1" Then Exit Sub
If Target.Offset(0, -1).Value & ".JPG" <> "" Then
If UCase(Right(Target.Offset(0, -1).Value & ".JPG", 3)) = "JPG" Or UCase(Right(Target.Offset(0, -1).Value & ".BMP", 3)) = "BMP" Then
Image1.Top = Target.Offset(0, 1).Top
Image1.Left = Target.Offset(0, 1).Left
If Not Image1.Visible Then Image1.Visible = True
If Dir(Cells(1, 18) & Target.Offset(0, -1).Value & ".JPG") <> "" Then
Image1.Picture = LoadPicture(Cells(1, 18) & Target.Offset(0, -1).Value & ".JPG")
Image1.AutoSize = True
Else
Image1.Picture = Empty
Image1.Visible = False
Image1.Picture = Nothing
End If
Else
GoTo son
End If
End If
Exit Sub
son:
Image1.Visible = False
Image1.Picture = Nothing
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo son
If Intersect(Target, [a:a]) Is Nothing Then Exit Sub
If Target.Value = "" Then
Target.Interior.ColorIndex = xlNone
Target.Offset(0, 1) = ""
Else
Set Bul = Sheets("liste").Columns("a").Find(Target, lookat:=xlWhole)
If Bul Is Nothing Then
Target.Interior.ColorIndex = 3
Target.Offset(0, 1) = ""
MsgBox Target.Value & " Degerini Bulamadim "
Else
Target.Interior.ColorIndex = xlNone
Target.Offset(0, 1) = Sheets("Liste").Cells(Bul.Row, "b")
Target.Offset(0, 2) = Sheets("liste").Cells(Bul.Row, "c")
Target.Offset(0, 3) = Sheets("liste").Cells(Bul.Row, "f")
End If
End If
son:
End Sub

 

[uzmanamele]

merhaba
buna benzer şekilde deneyiniz.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call kod_1
Call kod_2
End Sub

Sub kod_1()
MsgBox "1. kod çalıştı"
End Sub

Sub kod_2()
MsgBox "2. kod çalıştı"
End Sub

 

[janveljan]

Bu şekilde de olur zannediyorum.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.CutCopyMode = xlCopy Then Exit Sub
If Application.CutCopyMode = xlCut Then Exit Sub

If Intersect(Target, [A:B]) Is Nothing Then Exit Sub
If Target.Address = "$B$1" Then Exit Sub

If Target.Column = 2 Then
On Error Resume Next
    If Target.Offset(0, -1).Value & ".JPG" <> "" Then
        If UCase(Right(Target.Offset(0, -1).Value & ".JPG", 3)) = "JPG" Or UCase(Right(Target.Offset(0, -1).Value & ".BMP", 3)) = "BMP" Then
        Image1.Top = Target.Offset(0, 1).Top
        Image1.Left = Target.Offset(0, 1).Left
            If Not Image1.Visible Then Image1.Visible = True
                If Dir(Cells(1, 18) & Target.Offset(0, -1).Value & ".JPG") <> "" Then
                Image1.Picture = LoadPicture(Cells(1, 18) & Target.Offset(0, -1).Value & ".JPG")
                Image1.AutoSize = True
                Else
                Image1.Picture = Empty
                Image1.Visible = False
                Image1.Picture = Nothing
                End If
            Else
                GoTo son1
            End If
        End If
    End If
Exit Sub
son1:
Image1.Visible = False
Image1.Picture = Nothing
End If

On Error GoTo son2
    If Target.Value = "" Then
        Target.Interior.ColorIndex = xlNone
        Target.Offset(0, 1) = ""
    Else
        Set Bul = Sheets("liste").Columns("a").Find(Target, lookat:=xlWhole)
        If Bul Is Nothing Then
        Target.Interior.ColorIndex = 3
        Target.Offset(0, 1) = ""
        MsgBox Target.Value & " Degerini Bulamadim "
        Else
        Target.Interior.ColorIndex = xlNone
        Target.Offset(0, 1) = Sheets("Liste").Cells(Bul.Row, "b")
        Target.Offset(0, 2) = Sheets("liste").Cells(Bul.Row, "c")
        Target.Offset(0, 3) = Sheets("liste").Cells(Bul.Row, "f")
        End If
    End If
son2:
End Sub

 

[tahsinanarat]

Sn. janveljan ilginiz için teşekkür ederim, verdiğiniz şekilde hata veriyor, ancak ben ayrı ayrı çalıştırmayı hallettim, en baştaki "Option Explicit" i kaldırdığımda hata vermedi. Çok teşekkür ederim. Saygılar.