Soru Aynı Başlık Altındaki İki Kodu Birleştirme

[TURKOLOG]

Private Sub Workbook_Open()

ThisWorkbook.Kontrol

yer = Worksheets("yetki").Shapes("sifre").OLEFormat.Object.Characters.Text
ActiveWorkbook.Protect Password:=yer, Structure:=False ', Windows:=True' kapatmak

For j = 1 To ActiveWorkbook.Sheets.Count
If Sheets(j).Name <> "anasayfa" Then
Sheets(Sheets(j).Name).Visible = False
End If
Next
ActiveWorkbook.Protect Password:=yer, Structure:=True ', Windows:=True' kapatmak


kayıt = ThisWorkbook.Path & "\şifreli_işlem.1st" ' işlemlerin kayıt altına alındığı dosya


alan1 = RightPadChar("Program acildi", " ", 35) & "/"
alan2 = RightPadChar(Format(Now, "dd:mm:yyyy  : hh:mm:ss"), " ", 39) & "/"
alan3 = RightPadChar("", " ", 22) & "/"
alan4 = RightPadChar("Programa giris islemi yapildi", " ", 35) & "/"


yaz = alan1 & alan2 & alan3 & alan4



i = 1
On Error Resume Next
Do While i <> Len(yaz) + 1
yazi = Mid(yaz, i, 1)
yazi = Chr(Asc(yazi) + 120)
kon = kon + yazi
i = i + 1
Loop


Open kayıt For Append As #1
Print #1, kon
'Print #1, alan1 & alan2 & alan3
Close #1


Application.Visible = False
Form.Show
ActiveWorkbook.Save


Application.DisplayAlerts = True
ver = ThisWorkbook.Path & "\"
ser = "Yedek " & CreateObject("Scripting.FileSystemObject").GetBaseName(ThisWorkbook.FullName) & ".xlk"
eskısıl = ver & ser
If CreateObject("Scripting.FileSystemObject").FileExists(eskısıl) = True Then
Kill eskısıl
End If
'On Error Resume Next
Application.DisplayAlerts = False

End Sub

Bu kod ile

Code:
Private Sub Workbook_Open()
'Application.Visible = false
Dim Seri, HddKontrolSeri, Lisans, LisansKntrl, kontrol As String
Dim HddKontrol As Variant
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Surucu = FSO.GetDrive("C:")
Hddserino = Surucu.serialnumber
Set Surucu = Nothing
Set FSO = Nothing
LisansKntrl = GetSetting("ProV1", "V1", "SerialKontrol")
Lisans = Replace(LisansKntrl, "-", "")

kontrol = Mid(Lisans, 2, 1) & Mid(Lisans, 19, 1) & Mid(Lisans, 18, 1) & Mid(Lisans, 15, 1) & "-" & _
           Mid(Lisans, 8, 1) & Mid(Lisans, 13, 1) & Mid(Lisans, 4, 1) & Mid(Lisans, 5, 1) & "-" & _
           Mid(Lisans, 12, 1) & Mid(Lisans, 1, 1) & Mid(Lisans, 10, 1) & Mid(Lisans, 9, 1) & "-" & _
           Mid(Lisans, 16, 1) & Mid(Lisans, 17, 1) & Mid(Lisans, 14, 1) & Mid(Lisans, 7, 1) & "-" & _
           Mid(Lisans, 6, 1) & Mid(Lisans, 3, 1) & Mid(Lisans, 20, 1) & Mid(Lisans, 11, 1)

Seri = GetSetting("ProV1", "V1", "Serial")
HddKontrolSeri = GetSetting("ProV1", "V1", "Serial")
HddKontrol = Replace(HddKontrolSeri, "-", "")
Hddserino = Replace(Hddserino, "-", "")
Hddserino = Mid(Hddserino, 1, 7)
HddKontrol = Mid(HddKontrol, 11, 1) & Mid(HddKontrol, 12, 1) & Mid(HddKontrol, 14, 1) & Mid(HddKontrol, 15, 1) & Mid(HddKontrol, 16, 1) & Mid(HddKontrol, 18, 1) & Mid(HddKontrol, 19, 1)

If Seri = Empty Or kontrol <> Seri Or Hddserino <> HddKontrol Then
    MsgBox "Ürünün kayıt numarası hatalı. Lütfen program yetkilisi ile görüşünüz. ", vbCritical + vbOKOnly, "Hatalı Lisans Kodu"
   LisansAktif.Show
 Exit Sub
 Else
EndDate = DateValue(GetSetting("ProV1", "V1", "EndDate"))
 If EndDate < Date Then
    If EndDate < Now Then MsgBox "Lisans Kullanım Süreniz Bitmistir. Lütfen program yetkilisi ile görüşünüz.", vbCritical + vbOKOnly, "Lisans Kullanım Süresi Doldu..."
      LisansAktif.Show: Exit Sub
        End If
        End If
        Giriş.Show
End Sub

Sirasi ile bu iki kodu Nasıl birleştirebiliriz.