- Katılım
- 15 Eylül 2012
- Mesajlar
- 72
- Excel Vers. ve Dili
- 2010 türkçe
- Altın Üyelik Bitiş Tarihi
- 01-02-2025
1 - G5 L5 birleşik hücreye sadece harf girişine izin vermek istiyorum.
2 - G6 L6 hücresine plaka yazdığım zaman onu otomatik XX XXX XXXX şeklinde ayırmasını istiyorum.
3 - Belirlediğim adrese yeni bir klasör oluşturup klasörün adını da G6 ve G7 hücrelerinde yazdığım yazıları getirip güncel tarih saat ile eklemesini istiyorum.
4 - Eklediğim resme tıkladığım zaman belirttiğim adrese belirttiğim hücredeki yazı ile kayıt yapıyor.
kod aşağıdaki gibi,
Sub Resim57_Tıklat()
'Private Sub Resim57_Tıklat(ByVal Target As Range)
ActiveSheet.Range("F8").Select
On Error GoTo son
If Intersect(Target, ['ADIM'!E8]) Is Nothing Then GoTo 10
Application.EnableEvents = False
' If Target.Value = "." Then GoTo Son
If IsNumeric(Target) = False Then
MsgBox "!!! Lütfen Girişini yapınız...", vbInformation, "UYARI !!!"
Target = ""
' Target.Offset(0, 0).Select
Else
GoTo 10
End If
son:
Application.EnableEvents = True
10:
Sayfa2.Visible = False
'Sayfa2.Protect
On Error Resume Next
Application.ScreenUpdating = False
If [E8].Value = "" Then
MsgBox "!!! Lütfen Yazınız."
GoTo 20
Else
If [E6].Value = "" Then
MsgBox "!!! Yazınız."
Else
Dim silinecek As String
silinecek = ActiveWorkbook.Name
'istediğim klasöre farklı kaydet
Dim dosyam As String
Dim tarih As String
tarih = Format(Now, " _DD-MMM-YYYY_hh.mm.ss")
With Sheets("ADIM")
dosyam = "\\10.0.0.10\ YAPILANLAR\" & .Range("E6").Value & tarih & ".xlsm"
ActiveWorkbook.SaveAs FileName:=dosyam
Kill "\\10.0.0.10\ AÇILIŞ\" & silinecek & " "
End With
MsgBox " Kayıt işlemi bitmiştir. İYİ ÇALIŞMALAR...", vbInformation, "Kaydet"
dosyam = vbNullString
'istediğim klasöre farklı kaydet
Application.Quit
End If
20:
End If
End Sub
Ben daha sonra o kaydettiğim exel dosyasını açtığım zaman üzerinde değişikler yaptıktan sonra yeniden resme tıkladığımda hata veriyor.
YARDIMCI OLURSANIZ LÜTFEN, ŞİMDİDEN TEŞEKKÜR EDERİM...
2 - G6 L6 hücresine plaka yazdığım zaman onu otomatik XX XXX XXXX şeklinde ayırmasını istiyorum.
3 - Belirlediğim adrese yeni bir klasör oluşturup klasörün adını da G6 ve G7 hücrelerinde yazdığım yazıları getirip güncel tarih saat ile eklemesini istiyorum.
4 - Eklediğim resme tıkladığım zaman belirttiğim adrese belirttiğim hücredeki yazı ile kayıt yapıyor.
kod aşağıdaki gibi,
Sub Resim57_Tıklat()
'Private Sub Resim57_Tıklat(ByVal Target As Range)
ActiveSheet.Range("F8").Select
On Error GoTo son
If Intersect(Target, ['ADIM'!E8]) Is Nothing Then GoTo 10
Application.EnableEvents = False
' If Target.Value = "." Then GoTo Son
If IsNumeric(Target) = False Then
MsgBox "!!! Lütfen Girişini yapınız...", vbInformation, "UYARI !!!"
Target = ""
' Target.Offset(0, 0).Select
Else
GoTo 10
End If
son:
Application.EnableEvents = True
10:
Sayfa2.Visible = False
'Sayfa2.Protect
On Error Resume Next
Application.ScreenUpdating = False
If [E8].Value = "" Then
MsgBox "!!! Lütfen Yazınız."
GoTo 20
Else
If [E6].Value = "" Then
MsgBox "!!! Yazınız."
Else
Dim silinecek As String
silinecek = ActiveWorkbook.Name
'istediğim klasöre farklı kaydet
Dim dosyam As String
Dim tarih As String
tarih = Format(Now, " _DD-MMM-YYYY_hh.mm.ss")
With Sheets("ADIM")
dosyam = "\\10.0.0.10\ YAPILANLAR\" & .Range("E6").Value & tarih & ".xlsm"
ActiveWorkbook.SaveAs FileName:=dosyam
Kill "\\10.0.0.10\ AÇILIŞ\" & silinecek & " "
End With
MsgBox " Kayıt işlemi bitmiştir. İYİ ÇALIŞMALAR...", vbInformation, "Kaydet"
dosyam = vbNullString
'istediğim klasöre farklı kaydet
Application.Quit
End If
20:
End If
End Sub
Ben daha sonra o kaydettiğim exel dosyasını açtığım zaman üzerinde değişikler yaptıktan sonra yeniden resme tıkladığımda hata veriyor.
YARDIMCI OLURSANIZ LÜTFEN, ŞİMDİDEN TEŞEKKÜR EDERİM...