BİRDEN FAZLA KONUDA YARDIM ???

comp_wolf

Altın Üye
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...
 
Üst