Otomatik kod çalıştırma

[magnet2014]

Arkadaşlar merhaba,

Excel çalışma kitabı açıldığında aşağıdaki kod otomatik çalışmıyor. Manuel çalıştırmam gerekiyor. Sebebi ne olabilir? Otomatik mail atan bir kod olduğu için çalışma kitabı açılır açılmaz bu makro çalışsın istiyorum


Option Explicit
Dim Outlook_App As Object
Dim Outlook_Mail As Object
Sub auto_open()
Dim STR As Long
For STR = 3 To Range("B" & Rows.Count).End(xlUp).Row
Set Outlook_App = CreateObject("Outlook.Application")
Set Outlook_Mail = Outlook_App.CreateItem(0)
If Date + 2 = Cells(STR, "E") Or Date + 5 = Cells(STR, "E") Then
If Cells(STR, "F") <> "Tamamlandi" Then
If Cells(STR, "I") <> "Gönderildi" Then
If Cells(STR, "J") <> "Gönderildi" Then
With Outlook_Mail
.To = Cells(STR, "H")
.CC = ""
.BCC = ""
.Subject = "Devam Eden Projeler-Hatirlatma!"
.Body = "Merhaba " & Cells(STR, "B") & vbCrLf & "" & vbCrLf & _
"Tarafinizdan yürülmekte olan " & "'" & Cells(STR, "C") & "'" & "için tamamlamaniz gereken son tarih " & Format(Cells(STR, "E"), "dd.mm.yyyy") & " dir." & _
"Bu sebeple çalismanizin son durumunu kontrol edin lütfen. " & vbCrLf & vbCrLf & _
"Iyi Çalismalar" & vbCrLf & _
"HAKAN ÜNAL"
.Save
.Send
If Date + 5 = Cells(STR, "E") Then
Cells(STR, "I") = "Gönderildi"
ElseIf Date + 2 = Cells(STR, "E") Then
Cells(STR, "J") = "Gönderildi"
Else
Cells(STR, "I") = "" And Cells(STR, "J") = ""
End If
End With
End If: End If: End If: End If
Next
End Sub

 

[Emir Hüseyin Çoban]

. . .

Kodlar açılışta çalışıyor.
Makro güvenlik ayarlarınızı veya 2010 versiyonundan sonra daha çok ortaya çıkan açılışta etkinleştirme ayarlarını kontrol ediniz.

. . .

 

[magnet2014]

. . .

Kodlar açılışta çalışıyor.
Makro güvenlik ayarlarınızı veya 2010 versiyonundan sonra daha çok ortaya çıkan açılışta etkinleştirme ayarlarını kontrol ediniz.

. . .

Hüseyin Bey,

Söylediğiniz gibi bütün güvenlik ayarlarına baktım. Herşey uygun gözüküyor ancak yinede manuel çalıştırmak zorunda kalıyorum. Excel çalışma kitabında bu sayfanın bulunduğu diğer sayfalarda da değişik kodlar mevcut. Onlar engelliyor olabilir mi? Çalışma kitabı açıldığında bu sayfada ki kodun çalışmasını nasıl sağlayabilirim?

 

[aykiriatilla]

Hüseyin Bey,

Söylediğiniz gibi bütün güvenlik ayarlarına baktım. Herşey uygun gözüküyor ancak yinede manuel çalıştırmak zorunda kalıyorum. Excel çalışma kitabında bu sayfanın bulunduğu diğer sayfalarda da değişik kodlar mevcut. Onlar engelliyor olabilir mi? Çalışma kitabı açıldığında bu sayfada ki kodun çalışmasını nasıl sağlayabilirim?

Merhaba,

Ekteki ekran görüntüsünü kontrol ediniz. Sanırım sorun bundan kaynaklı.

İyi günler.

 

[Emir Hüseyin Çoban]

. . .

Sy magnet2014,
geri dönüşünüzü atlamışım k.bakmayın.
Önerileri deneyin. Yine olmazsa TeamViewer ile bağlanıp kontrol edebilirim...

. . .

 

[magnet2014]

. . .

Sy magnet2014,
geri dönüşünüzü atlamışım k.bakmayın.
Önerileri deneyin. Yine olmazsa TeamViewer ile bağlanıp kontrol edebilirim...

. . .

Hüseyin Bey,

Sizleri de yordum ancak son birşey daha denemek istiyorum. Kod otomatik çalışmadığı için ilgili sayfa(GOREVLER) yerine this Workbook'a kopyalamak istedim ve kodu aşağıdaki şekilde düzenledim. Dosya otomatik yedek alma kodu da burada olduğu için çakışıyor ve hata veriyor. Bu konuda uzman değilim nerede hata yapıyorum yardımcı olur musunuz.

Teşekkür ederim

Private Sub Workbook_Open()
Dim a
Dim klasor As String
Set a = CreateObject("scripting.filesystemobject")
klasor = "W:\Engineering\2016 Proje Takip\GOC TAKiP 2016\Yedek\"

If a.FileExists(klasor & "Teknik_" & Date - 2 & ".xlsm") = True Then Exit Sub
If a.FileExists(klasor & "Teknik_" & Date - 1 & ".xlsm") = True Then Exit Sub
If a.FileExists(klasor & "Teknik_" & Date & ".xlsm") = True Then Exit Sub
Dim kopyayolla, dosyam As String
Dim frmt As Long
frmt = Application.DefaultSaveFormat
Application.DefaultSaveFormat = ThisWorkbook.FileFormat
dosyam = "GOC TAKIP_" & Date & ".xlsm"
kopyayolla = klasor & dosyam
ThisWorkbook.SaveCopyAs kopyayolla
Application.DefaultSaveFormat = frmt
dosyam = vbNullString
End Sub

-----------------------------------------------------------
Option Explicit
Dim Outlook_App As Object
Dim Outlook_Mail As Object
Sub auto_open()
Set g = Sheets("GOREVLER")
Dim STR As Long
For STR = 3 To g.Range("B" & Rows.Count).End(xlUp).Row
Set Outlook_App = CreateObject("Outlook.Application")
Set Outlook_Mail = Outlook_App.CreateItem(0)
If Date + 2 = g.Cells(STR, "E") Or Date + 5 = g.Cells(STR, "E") Then
If g.Cells(STR, "F") <> "Tamamlandi" Then
If g.Cells(STR, "I") <> "Gönderildi" Then
If g.Cells(STR, "J") <> "Gönderildi" Then
With Outlook_Mail
.To = g.Cells(STR, "H")
.CC = "hakan.unal@demirorenpetrol.com.tr"
.BCC = ""
.Subject = "Devam Eden Projeler-Hatirlatma!"
.Body = "Merhaba " & g.Cells(STR, "B") & vbCrLf & "" & vbCrLf & _
"Tarafinizdan yürülmekte olan " & "'" & g.Cells(STR, "C") & "'" & "için tamamlamaniz gereken son tarih " & Format(g.Cells(STR, "E"), "dd.mm.yyyy") & " dir." & _
"Bu sebeple çalismanizin son durumunu kontrol edin lütfen. " & vbCrLf & vbCrLf & _
"Iyi Çalismalar" & vbCrLf & _
"HAKAN ÜNAL"
.Save
.Send
If Date + 5 = g.Cells(STR, "E") Then
g.Cells(STR, "I") = "Gönderildi"
ElseIf Date + 2 = g.Cells(STR, "E") Then
g.Cells(STR, "J") = "Gönderildi"
Else
g.Cells(STR, "I") = "" And g.Cells(STR, "J") = ""
End If
End With
End If: End If: End If: End If
Next
End Sub

 

[Emir Hüseyin Çoban]

Hüseyin Bey,

Sizleri de yordum ancak son birşey daha denemek istiyorum. Kod otomatik çalışmadığı için ilgili sayfa(GOREVLER) yerine this Workbook'a kopyalamak istedim ve kodu aşağıdaki şekilde düzenledim. Dosya otomatik yedek alma kodu da burada olduğu için çakışıyor ve hata veriyor. Bu konuda uzman değilim nerede hata yapıyorum yardımcı olur musunuz.
Teşekkür ederim

. . .

Hatanız kırmızı ile belirttiğim kısım olabilir

sub auto_open kodları sayfa kod bölünde olmayacak,
Insert ten yeni modül ekleyin. auto_open kodlarını onun içine alın...

Bu şekilde deneyip, sonucu bildirirsiniz...

Müsait olduğunuzda inceleyiniz;
#

 Tagının Kullanımı Hk. >>[/COLOR][/B][/I][/URL]


. . .

 

[magnet2014]

Hüseyin Bey,

Söylediğiniz gibi bir modül açıp kodu içerisine kopyaladım ama resimde eklediğim şekilde bir uyarı aldım. Destek ve yardımınız için çok teşekkür ederim.

 

[asi_kral]

Merhaba

Sub auto_open()
Dim g as Worksheet

ikinci satırı ilk satırın altına yerleştirin.

 

[magnet2014]

Çalışıyor)Çok ama çok teşekkür ederim