DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sheets("Sayfa1").Copy
Application.DisplayAlerts = False
Set Dosya = CreateObject("Scripting.FileSystemObject")
yol ="C:\" & Workbooks(1).Sheets("Sayfa1").Range("A2")
If Not Dosya.FolderExists(yol) Then
Dosya.CreateFolder (yol)
End If
ActiveWorkbook.SaveAs yol &"\" & Workbooks(1).Sheets("Sayfa1").Range("A1")
ActiveWorkbook.Close
Application.DisplayAlerts = True
Workbooks.Open Filename:="D:\\Kitap2.xls"
Workbooks(1).Activate
Sheets("Sheet1").Copy Before:=Workbooks("Kitap2.xls").Sheets(1)
Workbooks("Kitap2.xls").Save
Workbooks("Kitap2.xls").Close
evet, kullanıcılar ayrı bilgisayarlarda çalışacak. tüm bu excel dosyalarını bir klasöre atıp ortak alana eklemeyi düşünüyoruz. aslında web tabanlı olarak wampserverda bir index oluşturdum. excelde tablo ile oluşturduğum şekli dynamic-table ile oluşturdum. sorun şu ki; bu dinamik tablodaki tüm satırları phpMyAdmin ile oluşturduğum database'e tümüyle nasıl aktaracağımı bilemiyorum. Ayrıca Master excel çalışma kitabında sorgu imkanım varken kullanıcının bu sorguyu database'den nasıl yapacağını düşündüm. Çünkü eğer master, bir excel sayfası olursa kullanıcı, sütun başlıklarındaki pivotlar yardımı ile ilgili özelliğe ait istediği değeri seçip sonuç görebilecek fakat bu sorgunun database için mümkün olup olmadığı hakkında bir bilgim yok maalesef. Önerebileceğiniz bir çıkar yol var mıdır?Kullanıcılar ayrı bilgisayarda mı çalışıyorlar?
Bu tip önlemler tam anlamı ile dosta kilit babında. Bilgisayar ve vba konusunda bilgisi olan kötü niyetli kişileri engellemez.
Web tabanlı çalışmalar bu konuda daha kullanışlıdır.
Private Sub CommandButton1_Click()
Application.DisplayAlerts = False
ActiveSheet.Copy
With ActiveWorkbook
isim = "C:\Users\MUSTAFA\Desktop\eeee\" & .ActiveSheet.Range("B5") & "." & "xlsx"
.SaveAs isim
.Close
Worksheets("ARŞİV").Select
sonsat = Cells(Rows.Count, "K").End(3).Row + 1
Range("K" & sonsat).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=isim, TextToDisplay:=isim
End With
Application.DisplayAlerts = True
MsgBox "İşlem tamam.", vbInformation
End Sub
Private Sub CommandButton1_Click()
Application.DisplayAlerts = False
ActiveSheet.Copy
With ActiveWorkbook
isim = "C:\Users\MUSTAFA\Desktop\eeee\" & .ActiveSheet.Range("B5") & "." & "xlsx"
.SaveAs isim
.Close
End With
Worksheets("ARŞİV").Select
sonsat = Worksheets("ARŞİV").Range("K" & 65536).End(xlUp).Offset(1, 0).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=isim, TextToDisplay:=isim
Application.DisplayAlerts = True
MsgBox "İşlem tamam.", vbInformation
End Sub