Skip to main content

AccessTr.neT


Önce Bul Sonra Kaydet Veya Farklı Kaydet

Önce Bul Sonra Kaydet Veya Farklı Kaydet

Shocked #13
(26/04/2019, 15:15)haliliyas yazdı: yalnız bir şeyi belirtmem lazım 
StrDosyaAdi = Dir$(CurrentProject.Path & "\*.xlsm") sadece .xlsm ile biten ilk dosyayı alır
5 tane Excel dosyası olsa bile  
StrDosyaAdi =excel1.xlsm olur diğer dosyaları incelemez.
klasörde tek Excel dosyası varsa sorun değil ama birden fazla Excel dosyasında sadece kodun bu kısmını yazarsanız işe yaramaz.
asıl kod aşağıdak gibi olmalı.

StrDosyaAdi = Dir$(CurrentProject.Path & "\*.xlsm") 

Do While StrDosyaAdi <> ""
'.....yapılacak işler mesela If  InStr(StrDosyaAdi,  CStr(Range("G6").Value), 1 )>0 Then

   StrDosyaAdi = Dir$
Loop
siz  and instr().... kısmı olsun mu istiyorsunuz olmasın mı tam anlamadım son cümleniz ve ondan 1 önceki cümlenizden zıt anlamlar çıkıyor.)

üstat
bu kod da hem dosya adı varsa hem de G6 hücresinin değeri varsa diyor yaa biz sadece G6 değeri varsa yapamıyormuyuz bu kod kısmını acaba ?
ben sadece dosya adının içinde G6 hücresinde geçen kısmı var sa olsun istiyorum yoksa devam edecek? sanırım bu sefer anlatabildim size üstat.
Cevapla
#14
StrDosyaAdi = Dir$(CurrentProject.Path & "\*.xlsm")
If  InStr(StrDosyaAdi,  CStr(Range("G6").Value), 1 )>0 Then  'yani dosya adında G& değeri varsa derseniz de olur ama 
mesela 2 Excel dosyası var ilki dosyanın adı 3.excel 2. dosyanın adı ise G& değerine sahip
yukarda yazıldığı şekliyle yaparsanız aradığınız özelliklere sahip olmasına ragmen yokmuş gibi davranır uygulamanız
Cevapla
Sad #15
(26/04/2019, 17:20)haliliyas yazdı: StrDosyaAdi = Dir$(CurrentProject.Path & "\*.xlsm")
If  InStr(StrDosyaAdi,  CStr(Range("G6").Value), 1 )>0 Then  'yani dosya adında G& değeri varsa derseniz de olur ama 
mesela 2 Excel dosyası var ilki dosyanın adı 3.excel 2. dosyanın adı ise G& değerine sahip
yukarda yazıldığı şekliyle yaparsanız aradığınız özelliklere sahip olmasına ragmen yokmuş gibi davranır uygulamanız

'kayıtlı dosya ismi bulma
Dim StrDosyaAdi As String
StrDosyaAdi = Dir$(CurrentProject.Path & "\*.xlsm")
If InStr(StrDosyaAdi, CStr(Range("G6").Value), 1) > 0 Then   'yani dosya adında G6 değeri varsa
GoTo 20  'xlsm varsa yapılacaklar
Else
GoTo 30  'yoksa yapılacaklar
End If
'kayıtlı dosya ismi bulma işlemi bitti
30:
........
20:
ThisWorkbook.Save
'exelden çıkış
ActiveSheet.Protect Password:="1453"
Application.Quit
'exelden çıkış işlemi bitti




üstat kodu böyle yapıyorum ama yine de olduğu bulunduğu dosya isminde kayıt yapıyor G6 hücresinde geçen 35 FAE 12345 ama dosya ismi farklı yeni dosya açma kısmına goto 30 a geçmiyor direk goto 20 den devam ediyor. dosya ismi ile G6 farklı olunca goto 30 a geçmesi gerekiyor. nasıl çözeriz ???
Cevapla
#16

StrDosyaAdi = Dir$(CurrentProject.Path & "\*.xlsm")
msgbox(StrDosyaAdi)
msgbox(CStr(Range("G6").Value))
msgbox(InStr(StrDosyaAdi, CStr(Range("G6").Value), 1))
kodunu dener misiniz?
mesaj kutularında ne yazıyor
Cevapla
#17
ActiveSheet.Protect Password:=.....
'plakalık, Araç Markası ve Araç Yılı boş işe uyarı veriyor
On Error Resume Next
 Application.ScreenUpdating = False

Dim DosyaVar as integer
DosyaVar=0
'___________________________________________________________________________________________
If [G7].Value <> "" and [G6].Value <> "" and [R7].Value <> "" then
StrDosyaAdi= Dir$(CurrentProject.Path & "\*.xlsm")
Do While StrDosyaAdi<> ""
    If  InStr(StrDosyaAdi,  CStr(Range("G6").Value), 1 )>0 Then DosyaVar=1
    StrDosyaAdi= Dir$
Loop
else
'[G7], [G6] veya [R7] hücrelerinden her hangi 1 boşsa
If [G7].Value = "" Then msgbox ".....
If [67].Value = "" then msgbox ".....
If [R7].Value = "" then msgbox ".....
end if
'________________________________________
if DosyaVar=0 then
'dosya yoksa yapılacak işlemler
end if
'________________________________________
if DosyaVar=1 then
'dosya varsa yapılacak işlemler
end if
'________________________________________
yukardaki kodu dener misiniz?
sadece temel mantığı yazdım
Cevapla
Sad #18
(27/04/2019, 00:05)haliliyas yazdı:
ActiveSheet.Protect Password:=.....
'plakalık, Araç Markası ve Araç Yılı boş işe uyarı veriyor
On Error Resume Next
 Application.ScreenUpdating = False

Dim DosyaVar as integer
DosyaVar=0
'___________________________________________________________________________________________
If [G7].Value <> "" and [G6].Value <> "" and [R7].Value <> "" then
StrDosyaAdi= Dir$(CurrentProject.Path & "\*.xlsm")
Do While StrDosyaAdi<> ""
    If  InStr(StrDosyaAdi,  CStr(Range("G6").Value), 1 )>0 Then DosyaVar=1
    StrDosyaAdi= Dir$
Loop
else
'[G7], [G6] veya [R7] hücrelerinden her hangi 1 boşsa
If [G7].Value = "" Then msgbox ".....
If [67].Value = "" then msgbox ".....
If [R7].Value = "" then msgbox ".....
end if
'________________________________________
if DosyaVar=0 then
'dosya yoksa yapılacak işlemler
end if
'________________________________________
if DosyaVar=1 then
'dosya varsa yapılacak işlemler
end if
'________________________________________
yukardaki kodu dener misiniz?
sadece temel mantığı yazdım

üstat teşekkürler,
dediğiniz kodu denedim ama maalesef oda olmuyor. mantığı ile bir kaç deneme daha yaptım ama yine olmuyor.
bulunduğu konumda G6 hücresinde yazan örnek: 99 ABC 123 gibi her hangi bir yazı varsa GOTO 20 yoksa GOTO 30 olmasını istiyorum ama bir türlü olmadı Img-cray
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task