Makrolarda çakışma sorunu

K

kutman

Katılım
6 Eylül 2011
Mesajlar
73
Excel Vers. ve Dili
2007 TÜRKÇE
Benim 2 tane makrom var aynı anda çalıştığı için çakışıyor çalışmıyor galiba bunu sıralı yapabilirmiyiz. 1 makrom çalışıp onaylandıktan sonra ikinci makrom devreye girecek.
1 makrom mac adresi eşlemesi.
2 makrom kullanıcı adı şifre .
Mevcut kullandığım kodlar.

1 işlem makrom mac adresi doğrulama şuan ki kodum:

Kod: 
Option Explicit
Sub testme01()
 
Dim strComputer As String
Dim objWMIService As Object
Dim colAdapters As Object
Dim objAdapter As Object
 
strComputer = "."
Set objWMIService = GetObject _
("winmgmts:" & "!\\" & strComputer & "\root\cimv2")
Set colAdapters = objWMIService.ExecQuery _
("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled = True")
For Each objAdapter In colAdapters
'MsgBox "Physical address: " & objAdapter.MACAddress
Sheets("SINAMA").Select
[a1] = "Physical address: "
[a2] = objAdapter.MACAddress
Columns("a").AutoFit
Next objAdapter
End Sub
Sub auto_open()
Static HATA As Integer
Dim KULLANICI As Long
Call testme01
On Error GoTo HATALI_GİRİŞ
Application.Visible = False
With Sheets("SINAMA").Range("H1:H100")
KULLANICI = .Find(What:=Cells(2, 1).Value, After:=.Cells(1, 1), LookIn:=xlValues, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase _
        :=True, SearchFormat:=False).Row
End With
If KULLANICI = 0 Then GoTo HATALI_GİRİŞ
MsgBox "Sisteme girişiniz onaylanmıştır.", vbInformation, "HOŞGELDİNİZ "
Application.Visible = True
Exit Sub
HATALI_GİRİŞ:
MsgBox "Bu bilgisayarda , bu dosyayı çalıştırmaya yetkiniz yoktur." _
& Chr(10) & "Lütfen sistem yöneticisiyle iletişime geçiniz." _
& Chr(10) & ".........", vbCritical, "DİKKAT !"
HATA = 1
Application.DisplayAlerts = False
If HATA = 1 Then Application.Quit
End Sub
2 işlem makrom.

Kod: 
Sub AUTO_OPEN()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("h")
For i = 1 To Worksheets.Count
If Sheets(i).Name <> "2015" Then
Sheets(i).Visible = xlVeryHidden
End If
Next i
'Application.Visible = False 'exceli kapatır
Call form_aç
Application.ScreenUpdating = True
End Sub

Sub form_aç()
UserForm1.Show 0
End Sub

İkinci işlemde ekrana gelen form kodu:

Kod: 
Private Sub kullanıcıadı_Change()

End Sub

Private Sub Label1_Click()

End Sub

Private Sub sicilno_Change()

End Sub

Private Sub UserForm_Activate()
Application.Visible = False 'exceli kapatır
End Sub

Private Sub gir_Click()
 Application.ScreenUpdating = False
Call başlangıç
 Application.ScreenUpdating = True
End Sub
Sub başlangıç()
Application.ScreenUpdating = False
Application.Visible = True
ThisWorkbook.Sheets("HAKKINDA").Visible = xlSheetVisible
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("h")
sor1 = sicilno.Text 'InputBox("SİCİL NO giriniz")
sor2 = kullanıcıadı.Text 'InputBox("Kullanıcı Adını giriniz")
sor3 = şifre.Text 'InputBox("Şifrenizi giriniz")
If sor1 = "" Or sor2 = "" Or sor3 = "" Then
Call kaydetvekapat
End If
For i = 2 To s1.Range("ıu1").End(xlUp).Column
If s1.Cells(1, i) = sor1 Then süt = i
Next i
sicilno = s1.Cells(1, süt)
kullanıcıadı = s1.Cells(2, süt)
baştar = s1.Cells(3, süt)
bittar = s1.Cells(4, süt)
şifre = s1.Cells(5, süt)
If Date >= baştar And Date <= bittar Then
For k = 6 To 20
For i = 1 To Worksheets.Count
If Sheets(i).Name = s1.Cells(k, süt).Text Then
Sheets(i).Visible = xlSheetVisible 'xlVeryHidden
End If
Next i
Next k
End If
If Date > bittar Then
Call çıkış
End If
Call userformukapat
Application.ScreenUpdating = True
End Sub

Sub tüm_sayfalar()
Application.ScreenUpdating = False
On Error Resume Next
For i = 1 To Worksheets.Count
ThisWorkbook.Sheets(i).Visible = xlSheetVisible
Next i
Application.ScreenUpdating = True
End Sub

Sub çıkış()
Application.ScreenUpdating = False
On Error Resume Next
With ThisWorkbook
.Save
.ChangeFileAccess Mode:=xlReadOnly
  
.Close SaveChanges:=False
  End With
  Application.ScreenUpdating = True
End Sub

Sub kaydetvekapat()
Application.ScreenUpdating = False
On Error Resume Next
With ThisWorkbook
.Save
.ChangeFileAccess Mode:=xlReadOnly
.Close SaveChanges:=False
  End With
 Application.ScreenUpdating = True
End Sub
Sub userformukapat() 'userform kapat
Application.ScreenUpdating = False
On Error Resume Next
    Unload UserForm1
    On Error GoTo 0
     Application.ScreenUpdating = True
End Sub
 
Son düzenleme:
kemalist

kemalist

Altın Üye
Katılım
4 Haziran 2008
Mesajlar
795
Excel Vers. ve Dili
Excel 2021 TÜRKÇE
Altın Üyelik Bitiş Tarihi
24-01-2026
Sub A()
testme01
AUTO_OPEN
End Sub

bu kodu denermisiniz?sırasıyla çalışacaktır.
 
K

kutman

Katılım
6 Eylül 2011
Mesajlar
73
Excel Vers. ve Dili
2007 TÜRKÇE
testme01 de sıkıntı yok . Ayrı iki modülde .

Aynı isimde Sub auto_open() var . İsimini değiştirdiğimde ismini değiştiridiğim çalışmıyor. 2 sini aynı isimde çalıştırınca çalışmıyor.

Kod: 
Sub auto_open()
Static HATA As Integer
Dim KULLANICI As Long
Call testme01
On Error GoTo HATALI_GİRİŞ
Application.Visible = False
With Sheets("SINAMA").Range("H1:H100")
KULLANICI = .Find(What:=Cells(2, 1).Value, After:=.Cells(1, 1), LookIn:=xlValues, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase _
        :=True, SearchFormat:=False).Row
End With
If KULLANICI = 0 Then GoTo HATALI_GİRİŞ
MsgBox "Sisteme girişiniz onaylanmıştır.", vbInformation, "HOŞGELDİNİZ "
Application.Visible = True
Exit Sub
HATALI_GİRİŞ:
MsgBox "Bu bilgisayarda , bu dosyayı çalıştırmaya yetkiniz yoktur." _
& Chr(10) & "Lütfen sistem yöneticisiyle iletişime geçiniz." _
& Chr(10) & ".........", vbCritical, "DİKKAT !"
HATA = 1
Application.DisplayAlerts = False
If HATA = 1 Then Application.Quit
End Sub
2 işlem makrom.
2. si
Kod: 
Sub AUTO_OPEN()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("h")
For i = 1 To Worksheets.Count
If Sheets(i).Name <> "2015" Then
Sheets(i).Visible = xlVeryHidden
End If
Next i
'Application.Visible = False 'exceli kapatır
Call form_aç
Application.ScreenUpdating = True
End Sub

Sub form_aç()
UserForm1.Show 0
End Sub
 
Zeki Gürsoy

Zeki Gürsoy

Uzman
Uzman
Katılım
31 Aralık 2005
Mesajlar
4,339
Excel Vers. ve Dili
Office 365 (64 bit) - Türkçe
Yanlış anlamayın ama bu kodlamayı yazabilen birinin sınıf modul haricinde yani standart modulde aynı isimde iki prosedur olamayacağını bilmesi gerekir. Bazen çok şaşırıyorum.
 
halit3

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,788
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Bu iki kod aynı isim olduğundan aynı dosyada ve aynı modülde çalışmaz.

Herhalde başka dosyadaki kodları kopyala yapıştır yaparak kullanmak istiyorsunuz.

kod:

Kod: 
Sub AUTO_OPEN()
Static HATA As Integer
Dim KULLANICI As Long
Call testme01
On Error GoTo HATALI_GİRİŞ
Application.Visible = False
With Sheets("SINAMA").Range("H1:H100")
KULLANICI = .Find(What:=Cells(2, 1).Value, After:=.Cells(1, 1), LookIn:=xlValues, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase _
        :=True, SearchFormat:=False).Row
End With
If KULLANICI = 0 Then GoTo HATALI_GİRİŞ
MsgBox "Sisteme girişiniz onaylanmıştır.", vbInformation, "HOŞGELDİNİZ "
Application.Visible = True

           [COLOR="Red"] 'Sub AUTO_OPEN()
            Application.ScreenUpdating = False
            On Error Resume Next
            Set s1 = ThisWorkbook.Worksheets("h")
            For i = 1 To Worksheets.Count
            If Sheets(i).Name <> "2015" Then
            Sheets(i).Visible = xlVeryHidden
            End If
            Next i
            'Application.Visible = False 'exceli kapatır
            Call form_aç
            Application.ScreenUpdating = True
            'End Sub[/COLOR]


Exit Sub
HATALI_GİRİŞ:
MsgBox "Bu bilgisayarda , bu dosyayı çalıştırmaya yetkiniz yoktur." _
& Chr(10) & "Lütfen sistem yöneticisiyle iletişime geçiniz." _
& Chr(10) & ".........", vbCritical, "DİKKAT !"
HATA = 1
Application.DisplayAlerts = False
If HATA = 1 Then Application.Quit


End Sub


Sub form_aç()
UserForm1.Show 0
End Sub
 
K

kutman

Katılım
6 Eylül 2011
Mesajlar
73
Excel Vers. ve Dili
2007 TÜRKÇE
Verdiğiniz kod hata verdi.

Halit bey benim demek istediği.

Sıralı işlem bu modül kodları ayrı ayrı dosyadalar adları aynı ve görevleri farklı.

aynı excelede yapıcam bu kodları ama sıralı çalışması gerekiyor.

1. si mac adresi doğrulama bu kod ile mac adresi doğrulanacak ve sistem doğrulanırsa excel açılacak excel açıldıkdıktan sonra .

2. si kullanıcı adı ve şifre modül kodu çalışacak ve gizli sayfalar açılacak.

amacım bu. kodları tekrar veriyorum.





MAC ADRESİ KODU.

Kod: 
Option Explicit
Sub testme01()
 
Dim strComputer As String
Dim objWMIService As Object
Dim colAdapters As Object
Dim objAdapter As Object
 
strComputer = "."
Set objWMIService = GetObject _
("winmgmts:" & "!\\" & strComputer & "\root\cimv2")
Set colAdapters = objWMIService.ExecQuery _
("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled = True")
For Each objAdapter In colAdapters
'MsgBox "Physical address: " & objAdapter.MACAddress
Sheets("SINAMA").Select
[a1] = "Physical address: "
[a2] = objAdapter.MACAddress
Columns("a").AutoFit
Next objAdapter
End Sub
Sub auto_open()
Static HATA As Integer
Dim KULLANICI As Long
Call testme01
On Error GoTo HATALI_GİRİŞ
Application.Visible = False
With Sheets("SINAMA").Range("H1:H100")
KULLANICI = .Find(What:=Cells(2, 1).Value, After:=.Cells(1, 1), LookIn:=xlValues, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase _
        :=True, SearchFormat:=False).Row
End With
If KULLANICI = 0 Then GoTo HATALI_GİRİŞ
MsgBox "Sisteme girişiniz onaylanmıştır.", vbInformation, "HOŞGELDİNİZ "
Application.Visible = True
Exit Sub
HATALI_GİRİŞ:
MsgBox "Bu bilgisayarda , bu dosyayı çalıştırmaya yetkiniz yoktur." _
& Chr(10) & "Lütfen sistem yöneticisiyle iletişime geçiniz." _
& Chr(10) & ".........", vbCritical, "DİKKAT !"
HATA = 1
Application.DisplayAlerts = False
If HATA = 1 Then Application.Quit
End Sub
SİSTEM GİRİŞ FORMU MODÜL KODU:

Kod: 
Sub AUTO_OPEN()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("h")
For i = 1 To Worksheets.Count
If Sheets(i).Name <> "2015" Then
Sheets(i).Visible = xlVeryHidden
End If
Next i
'Application.Visible = False 'exceli kapatır
Call form_aç
Application.ScreenUpdating = True
End Sub

Sub form_aç()
UserForm1.Show 0
End Sub
SİSTEM GİRİŞİN AÇILIR MENÜ GİRİŞ FORUMU KODU:

Kod: 
Private Sub kullanıcıadı_Change()

End Sub

Private Sub Label1_Click()

End Sub

Private Sub sicilno_Change()

End Sub

Private Sub UserForm_Activate()
Application.Visible = False 'exceli kapatır
End Sub

Private Sub gir_Click()
 Application.ScreenUpdating = False
Call başlangıç
 Application.ScreenUpdating = True
End Sub
Sub başlangıç()
Application.ScreenUpdating = False
Application.Visible = True
ThisWorkbook.Sheets("HAKKINDA").Visible = xlSheetVisible
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("h")
sor1 = sicilno.Text 'InputBox("SİCİL NO giriniz")
sor2 = kullanıcıadı.Text 'InputBox("Kullanıcı Adını giriniz")
sor3 = şifre.Text 'InputBox("Şifrenizi giriniz")
If sor1 = "" Or sor2 = "" Or sor3 = "" Then
Call kaydetvekapat
End If
For i = 2 To s1.Range("ıu1").End(xlUp).Column
If s1.Cells(1, i) = sor1 Then süt = i
Next i
sicilno = s1.Cells(1, süt)
kullanıcıadı = s1.Cells(2, süt)
baştar = s1.Cells(3, süt)
bittar = s1.Cells(4, süt)
şifre = s1.Cells(5, süt)
If Date >= baştar And Date <= bittar Then
For k = 6 To 20
For i = 1 To Worksheets.Count
If Sheets(i).Name = s1.Cells(k, süt).Text Then
Sheets(i).Visible = xlSheetVisible 'xlVeryHidden
End If
Next i
Next k
End If
If Date > bittar Then
Call çıkış
End If
Call userformukapat
Application.ScreenUpdating = True
End Sub

Sub tüm_sayfalar()
Application.ScreenUpdating = False
On Error Resume Next
For i = 1 To Worksheets.Count
ThisWorkbook.Sheets(i).Visible = xlSheetVisible
Next i
Application.ScreenUpdating = True
End Sub

Sub çıkış()
Application.ScreenUpdating = False
On Error Resume Next
With ThisWorkbook
.Save
.ChangeFileAccess Mode:=xlReadOnly
  
.Close SaveChanges:=False
  End With
  Application.ScreenUpdating = True
End Sub

Sub kaydetvekapat()
Application.ScreenUpdating = False
On Error Resume Next
With ThisWorkbook
.Save
.ChangeFileAccess Mode:=xlReadOnly
.Close SaveChanges:=False
  End With
 Application.ScreenUpdating = True
End Sub
Sub userformukapat() 'userform kapat
Application.ScreenUpdating = False
On Error Resume Next
    Unload UserForm1
    On Error GoTo 0
     Application.ScreenUpdating = True
End Sub
Kodlar bunlar. amacım sıralı işlem yaptırmak.

1.BİLGİSAYAR MAC ADRESİ DOĞRULAMA.
2. SİSTEME GİRİŞ EKRANI.
 
uzmanamele

uzmanamele

Uzman
Uzman
Katılım
26 Eylül 2007
Mesajlar
9,421
Excel Vers. ve Dili
excel 2010
Merhaba

Bir çok arkadaşımız aynı isimli 2 prosedürün olamayacağını söylemiş neden auto_open prosedürlerinde ısrar ediyorsunuz?
Birini auto_open altında yazın diğerini Workbook_Open altında. Önce Workbook_Open çalışır sonra auto_open devam edecektir.
 
K

kutman

Katılım
6 Eylül 2011
Mesajlar
73
Excel Vers. ve Dili
2007 TÜRKÇE
Farklı isimde yazıncada auto olan çalışıyor diğeri çalışmıyor anlatmak istediğim bu.
 
halit3

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,788
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
1 dolu mesajınız.
Benim 2 tane makrom var aynı anda çalıştığı için çakışıyor çalışmıyor galiba bunu sıralı yapabilirmiyiz. 1 makrom çalışıp onaylandıktan sonra ikinci makrom devreye girecek.
1 makrom mac adresi eşlemesi.
2 makrom kullanıcı adı şifre .
Mevcut kullandığım kodlar.

1 işlem makrom mac adresi doğrulama şuan ki kodum:
Genişletmek için tıkla ...
2 nolu mesajınız.

testme01 de sıkıntı yok . Ayrı iki modülde .

Aynı isimde Sub auto_open() var . İsimini değiştirdiğimde ismini değiştiridiğim çalışmıyor. 2 sini aynı isimde çalıştırınca çalışmıyor.
Genişletmek için tıkla ...
9 nolu mesajınız

Kod: 
Verdiğiniz kod hata verdi.

Halit bey benim demek istediği.

Sıralı işlem bu modül kodları [COLOR="red"]ayrı ayrı dosyadalar adları aynı[/COLOR] ve görevleri farklı.

aynı excelede yapıcam bu kodları ama sıralı çalışması gerekiyor.

1. si mac adresi doğrulama bu kod ile mac adresi doğrulanacak ve sistem doğrulanırsa excel açılacak excel açıldıkdıktan sonra .

2. si kullanıcı adı ve şifre modül kodu çalışacak ve gizli sayfalar açılacak.

amacım bu. kodları tekrar veriyorum.
Yukarıdaki mesajlarınız ya eksik yada her seferinde farklı istekler yada cevaplar geliyor.

3 mesajınızı birleştirdiğimde anladığım sizin ayrı ayrı dosyalarınız mevcut birinci dosyayı açınca gerekli işlemler yapıldıktan sonra otomatik 2. dosya açılacak ve o dosyada işlemler otomatik yapılacak.

Bunları nereden çıkardınız diye soracaksanız mesajlarınızın kırmızı yerlerindeki bölümlerden öyle anladım.
 
K

kutman

Katılım
6 Eylül 2011
Mesajlar
73
Excel Vers. ve Dili
2007 TÜRKÇE
Yazım hatam var ise yada yanlış anlattı isem özür dilerim. Halit bey normalde ayrı dosyada bu kodlar .ben bunları bir excelde birleştirdim ve bir excelde çalışacak. başka bir yere bağlantı yok.


Şimdi düzeltelim

aynı excelede yapıcam bu kodları sıralı çalışması gerekiyor buna bir çözüm üretebilirmiyiz.

1. si mac adresi doğrulama bu kod ile mac adresi doğrulanacak ve sistem doğrulanırsa excel açılacak excel açıldıkdıktan sonra .

2. si kullanıcı adı ve şifre modül kodu çalışacak ve gizli sayfalar açılacak.

amacım bu. kodları tekrar veriyorum.





MAC ADRESİ KODU.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Option Explicit
Sub testme01()

Dim strComputer As String
Dim objWMIService As Object
Dim colAdapters As Object
Dim objAdapter As Object

strComputer = "."
Set objWMIService = GetObject _
("winmgmts:" & "!\\" & strComputer & "\root\cimv2")
Set colAdapters = objWMIService.ExecQuery _
("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled = True")
For Each objAdapter In colAdapters
'MsgBox "Physical address: " & objAdapter.MACAddress
Sheets("SINAMA").Select
[a1] = "Physical address: "
[a2] = objAdapter.MACAddress
Columns("a").AutoFit
Next objAdapter
End Sub
Sub auto_open()
Static HATA As Integer
Dim KULLANICI As Long
Call testme01
On Error GoTo HATALI_GİRİŞ
Application.Visible = False
With Sheets("SINAMA").Range("H1:H100")
KULLANICI = .Find(What:=Cells(2, 1).Value, After:=.Cells(1, 1), LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase _
:=True, SearchFormat:=False).Row
End With
If KULLANICI = 0 Then GoTo HATALI_GİRİŞ
MsgBox "Sisteme girişiniz onaylanmıştır.", vbInformation, "HOŞGELDİNİZ "
Application.Visible = True
Exit Sub
HATALI_GİRİŞ:
MsgBox "Bu bilgisayarda , bu dosyayı çalıştırmaya yetkiniz yoktur." _
& Chr(10) & "Lütfen sistem yöneticisiyle iletişime geçiniz." _
& Chr(10) & ".........", vbCritical, "DİKKAT !"
HATA = 1
Application.DisplayAlerts = False
If HATA = 1 Then Application.Quit
End Sub
Genişletmek için tıkla ...
SİSTEM GİRİŞ FORMU MODÜL KODU:

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Kod: 
Sub AUTO_OPEN()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("h")
For i = 1 To Worksheets.Count
If Sheets(i).Name <> "2015" Then
Sheets(i).Visible = xlVeryHidden
End If
Next i
'Application.Visible = False 'exceli kapatır
Call form_aç
Application.ScreenUpdating = True
End Sub

Sub form_aç()
UserForm1.Show 0
End Sub
SİSTEM GİRİŞİN AÇILIR MENÜ GİRİŞ FORUMU KODU:

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Kod: 
Private Sub kullanıcıadı_Change()

End Sub

Private Sub Label1_Click()

End Sub

Private Sub sicilno_Change()

End Sub

Private Sub UserForm_Activate()
Application.Visible = False 'exceli kapatır
End Sub

Private Sub gir_Click()
 Application.ScreenUpdating = False
Call başlangıç
 Application.ScreenUpdating = True
End Sub
Sub başlangıç()
Application.ScreenUpdating = False
Application.Visible = True
ThisWorkbook.Sheets("HAKKINDA").Visible = xlSheetVisible
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("h")
sor1 = sicilno.Text 'InputBox("SİCİL NO giriniz")
sor2 = kullanıcıadı.Text 'InputBox("Kullanıcı Adını giriniz")
sor3 = şifre.Text 'InputBox("Şifrenizi giriniz")
If sor1 = "" Or sor2 = "" Or sor3 = "" Then
Call kaydetvekapat
End If
For i = 2 To s1.Range("ıu1").End(xlUp).Column
If s1.Cells(1, i) = sor1 Then süt = i
Next i
sicilno = s1.Cells(1, süt)
kullanıcıadı = s1.Cells(2, süt)
baştar = s1.Cells(3, süt)
bittar = s1.Cells(4, süt)
şifre = s1.Cells(5, süt)
If Date >= baştar And Date <= bittar Then
For k = 6 To 20
For i = 1 To Worksheets.Count
If Sheets(i).Name = s1.Cells(k, süt).Text Then
Sheets(i).Visible = xlSheetVisible 'xlVeryHidden
End If
Next i
Next k
End If
If Date > bittar Then
Call çıkış
End If
Call userformukapat
Application.ScreenUpdating = True
End Sub

Sub tüm_sayfalar()
Application.ScreenUpdating = False
On Error Resume Next
For i = 1 To Worksheets.Count
ThisWorkbook.Sheets(i).Visible = xlSheetVisible
Next i
Application.ScreenUpdating = True
End Sub

Sub çıkış()
Application.ScreenUpdating = False
On Error Resume Next
With ThisWorkbook
.Save
.ChangeFileAccess Mode:=xlReadOnly
  
.Close SaveChanges:=False
  End With
  Application.ScreenUpdating = True
End Sub

Sub kaydetvekapat()
Application.ScreenUpdating = False
On Error Resume Next
With ThisWorkbook
.Save
.ChangeFileAccess Mode:=xlReadOnly
.Close SaveChanges:=False
  End With
 Application.ScreenUpdating = True
End Sub
Sub userformukapat() 'userform kapat
Application.ScreenUpdating = False
On Error Resume Next
    Unload UserForm1
    On Error GoTo 0
     Application.ScreenUpdating = True
End Sub
Kodlar bunlar. amacım sıralı işlem yaptırmak.

1.BİLGİSAYAR MAC ADRESİ DOĞRULAMA.
2. SİSTEME GİRİŞ EKRANI.
 
halit3

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,788
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Aslında yukarıdaki mesajımın bir tanesinde bu uygulamayı yapmıştım.

Buraya eklediğin bütün kodları sil ondan sonra aşağıdaki kodları bir modülün içine ekle dosyayı kaydet ve kapat sonra aç

Kod: 
Option Explicit
Sub testme01()

Dim strComputer As String
Dim objWMIService As Object
Dim colAdapters As Object
Dim objAdapter As Object

strComputer = "."
Set objWMIService = GetObject _
("winmgmts:" & "!\\" & strComputer & "\root\cimv2")
Set colAdapters = objWMIService.ExecQuery _
("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled = True")
For Each objAdapter In colAdapters
'MsgBox "Physical address: " & objAdapter.MACAddress
Sheets("SINAMA").Select
[a1] = "Physical address: "
[a2] = objAdapter.MACAddress
Columns("a").AutoFit
Next objAdapter
End Sub
Sub AUTO_OPEN()

[COLOR="Red"]Dim s1, i[/COLOR]
Static HATA As Integer
Dim KULLANICI As Long
Call testme01
On Error GoTo HATALI_GİRİŞ
Application.Visible = False
With Sheets("SINAMA").Range("H1:H100")
KULLANICI = .Find(What:=Cells(2, 1).Value, After:=.Cells(1, 1), LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase _
:=True, SearchFormat:=False).Row
End With
If KULLANICI = 0 Then GoTo HATALI_GİRİŞ
MsgBox "Sisteme girişiniz onaylanmıştır.", vbInformation, "HOŞGELDİNİZ "

           [COLOR="Red"] Application.ScreenUpdating = False
            On Error Resume Next
            Set s1 = ThisWorkbook.Worksheets("h")
            For i = 1 To Worksheets.Count
            If Sheets(i).Name <> "2015" Then
            Sheets(i).Visible = xlVeryHidden
            End If
            Next i
            'Application.Visible = False 'exceli kapatır
            Call form_aç
            Application.ScreenUpdating = True[/COLOR]


Application.Visible = True
Exit Sub
HATALI_GİRİŞ:
MsgBox "Bu bilgisayarda , bu dosyayı çalıştırmaya yetkiniz yoktur." _
& Chr(10) & "Lütfen sistem yöneticisiyle iletişime geçiniz." _
& Chr(10) & ".........", vbCritical, "DİKKAT !"
HATA = 1
Application.DisplayAlerts = False
If HATA = 1 Then Application.Quit
End Sub


Sub form_aç()
UserForm1.Show 0
End Sub
 
K

kutman

Katılım
6 Eylül 2011
Mesajlar
73
Excel Vers. ve Dili
2007 TÜRKÇE
Halit bey size ne kadar teşekkür etsem azdır teşekkür ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst