checkBox kullanımı

[igultekin2000]

iyi akşamlar; D:\ klasöründe Firmalara ait klasörler ve içinde .pdf uzantılı dosyalar mevcut. bunların için sık sık döne seçerek dosyaları çekmem gerekiyor. Bu form' da bulduğum makro ile A sütununa yazdığım dosya ismine göre dosyaları C:\yeni klasörüne toplayabiliyorum. dönemler sürekli değiştiği için bir iki dosyayı CHECKBOX ile getirme örneği bulsam diğerlerini de ilave edebilirm. Çalışma sayfasından veri getirme örneği buldum ama dosya getirme örneği bulamadım. Teşekkürler. Kullandığım makro

Sub F_Copy()

Dim Beyannameler As String
Dim yeni As String

src = Range("I1").Value2
dest = Range("E1").Value2

For i = 2 To 3200
Beyannameler = src & Cells(i, 1) & ".pdf"
yeni = dest & Cells(i, 1) & ".pdf"

If CreateObject("Scripting.FileSystemObject").FileExists(Beyannameler) = True Then
If CreateObject("Scripting.FileSystemObject").FileExists(yeni) = False Then
FileCopy Beyannameler, yeni
'Name eski As yeni
Else
MsgBox "bu dosya mevcut" & Chr(10) & yeni
End If
End If

Next

End Sub

 

[halit3]

CheckBox nesneleri ardışık gitmeli yani birinci satır başlık olduğu için ikinci satırdan ikiden başlamalı 2,3,4,5,6,7, gibi

Sub F_Copy()

Dim Beyannameler As String
Dim yeni As String

src = Range("I1").Value2
dest = Range("E1").Value2

For i = 2 To Worksheets(ActiveSheet.Name).Cells(Rows.Count, "A").End(3).Row

If Worksheets(ActiveSheet.Name).Shapes("CheckBox" & i).OLEFormat.Object.Object.Value = True Then

Beyannameler = src & Cells(i, 1) & ".pdf"
yeni = dest & Cells(i, 1) & ".pdf"

If CreateObject("Scripting.FileSystemObject").FileExists(Beyannameler) = True Then
If CreateObject("Scripting.FileSystemObject").FileExists(yeni) = False Then
FileCopy Beyannameler, yeni
'Name eski As yeni
Else
MsgBox "bu dosya mevcut" & Chr(10) & yeni
End If
End If

End If

Next

End Sub

 

[igultekin2000]

çalışmanız için teşekkür ederim, benim checkBox isimlerini sıralamak dışnda ilave birşey yapmama gerek var mı? CheckBox' ları 2,3 olarak isimlendirdim ancak makro tetikleyince işlem yapmıyor. Makro içine ilave kod yazılacakmı, yoksa bu haliyle çalışması mı gerekiyor.

 

[igultekin2000]

CheckBox nesneleri ardışık gitmeli yani birinci satır başlık olduğu için ikinci satırdan ikiden başlamalı 2,3,4,5,6,7, gibi

Sub F_Copy()

Dim Beyannameler As String
Dim yeni As String

src = Range("I1").Value2
dest = Range("E1").Value2

For i = 2 To Worksheets(ActiveSheet.Name).Cells(Rows.Count, "A").End(3).Row

If Worksheets(ActiveSheet.Name).Shapes("CheckBox" & i).OLEFormat.Object.Object.Value = True Then

Beyannameler = src & Cells(i, 1) & ".pdf"
yeni = dest & Cells(i, 1) & ".pdf"

If CreateObject("Scripting.FileSystemObject").FileExists(Beyannameler) = True Then
If CreateObject("Scripting.FileSystemObject").FileExists(yeni) = False Then
FileCopy Beyannameler, yeni
'Name eski As yeni
Else
MsgBox "bu dosya mevcut" & Chr(10) & yeni
End If
End If

End If

Next

End Sub

 

[igultekin2000]

CheckBox nesneleri ardışık gitmeli yani birinci satır başlık olduğu için ikinci satırdan ikiden başlamalı 2,3,4,5,6,7, gibi

Sub F_Copy()

Dim Beyannameler As String
Dim yeni As String

src = Range("I1").Value2
dest = Range("E1").Value2

For i = 2 To Worksheets(ActiveSheet.Name).Cells(Rows.Count, "A").End(3).Row

If Worksheets(ActiveSheet.Name).Shapes("CheckBox" & i).OLEFormat.Object.Object.Value = True Then

Beyannameler = src & Cells(i, 1) & ".pdf"
yeni = dest & Cells(i, 1) & ".pdf"

If CreateObject("Scripting.FileSystemObject").FileExists(Beyannameler) = True Then
If CreateObject("Scripting.FileSystemObject").FileExists(yeni) = False Then
FileCopy Beyannameler, yeni
'Name eski As yeni
Else
MsgBox "bu dosya mevcut" & Chr(10) & yeni
End If
End If

End If

Next

End Sub

CheckBox nesneleri ardışık gitmeli yani birinci satır başlık olduğu için ikinci satırdan ikiden başlamalı 2,3,4,5,6,7, gibi

Sub F_Copy()

Dim Beyannameler As String
Dim yeni As String

src = Range("I1").Value2
dest = Range("E1").Value2

For i = 2 To Worksheets(ActiveSheet.Name).Cells(Rows.Count, "A").End(3).Row

If Worksheets(ActiveSheet.Name).Shapes("CheckBox" & i).OLEFormat.Object.Object.Value = True Then

Beyannameler = src & Cells(i, 1) & ".pdf"
yeni = dest & Cells(i, 1) & ".pdf"

If CreateObject("Scripting.FileSystemObject").FileExists(Beyannameler) = True Then
If CreateObject("Scripting.FileSystemObject").FileExists(yeni) = False Then
FileCopy Beyannameler, yeni
'Name eski As yeni
Else
MsgBox "bu dosya mevcut" & Chr(10) & yeni
End If
End If

End If

Next

End Sub

Belirttiğniz gibi Checboxların isimlerini 2,3 şeklinde sıralma yaptım, ancak bu haliyle makro tepki vermiyor. İlave bir şey ilave olacakmı yoksa checboxlara sıralama yapmak yetrlimiydi. ?

 

[halit3]

Nesneler içinde bir kod yazdım
nesne ekle düğmesine tıklayınca mevcut nesneleri siliyor ve B sutün genişliğinde B sutünu na nesneleri oluşturuyor.

 

[igultekin2000]

Nesneler içinde bir kod yazdım
nesne ekle düğmesine tıklayınca mevcut nesneleri siliyor ve B sutün genişliğinde B sutünu na nesneleri oluşturuyor.

rahatsız ediyorum ama bu şekilde hata verdi

 

[igultekin2000]

Nesneler içinde bir kod yazdım
nesne ekle düğmesine tıklayınca mevcut nesneleri siliyor ve B sutün genişliğinde B sutünu na nesneleri oluşturuyor.

teşekkür ederim sorun için baktığımda C:\ *.exd uzantılı dosyaları silmek şeklinde işlemle makro hatası çözüldü. Yani vermiş olduğunuz makroda sorun yoktur. Tekrar teşekkür eder, iyi çalışmalar dilerim.