- Katılım
- 2 Mart 2005
- Mesajlar
- 2,960
- Excel Vers. ve Dili
- ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
A çalışma kitabındaki komut düğmesine bsınca aşağıdaki kod çalışıyor... istediğim kırmızı ile işaretlediğim kısmın wkbYKTP değişkenli kitabın ThisWorkbook bölümüne yazılması?
Kod:
Private Sub CommandButton1_Click()
Dim wkbYKTP As Excel.Workbook
Dim wkbBKTP As Excel.Workbook
Dim wksSSYF As Excel.Worksheet
Dim wksYSYF As Excel.Worksheet
Dim dTARIH As Date
Dim intYKCS As Integer
Dim intSNGN As Integer
Dim strYADI As String
Set wkbYKTP = Workbooks.Add
Set wkbBKTP = ThisWorkbook
Set wksSSYF = wkbBKTP.Worksheets("SABLON")
dTARIH = InputBox("İşlem Yapacağınız Ayın ilkgününü aa/gg/yyyy şeklinde giriniz!")
intSNGN = Day(Format((DateSerial(Year(dTARIH), Month(dTARIH) + 1, 1)) - 1, "dd/mm/yyyy"))
intYKCS = wkbYKTP.Sheets.Count
strYADI = FncHsr_YazAy((Month(dTARIH))) & " " & Year(dTARIH) & ".xls"
If Fnc_DsyaVarMi("c:\Deneme\" & strYADI) = True Then
MsgBox "BU İSİMDE DOSYA DAHA ÖNCE OLUŞTURULMUŞ"
Else
wkbYKTP.SaveAs Filename:="c:\Deneme\" & strYADI, _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End If
For i = 1 To intSNGN
wksSSYF.Copy After:=wkbYKTP.Sheets(wkbYKTP.Sheets.Count)
Set wksYSYF = ActiveSheet
wksYSYF.Name = Format(dTARIH + i - 1, "dd.mm.yyyy")
Next
With wkbYKTP
For i = intYKCS To 1 Step -1
Application.DisplayAlerts = False 'ekrana mesaj vermeyi kapat
.Sheets(i).Delete
Application.DisplayAlerts = True 'ekrana mesaj vermeyi aç
Next i
End With
wksSSYF.Copy After:=wkbYKTP.Sheets(wkbYKTP.Sheets.Count)
Set wksYSYF = ActiveSheet
wksYSYF.Name = "TOPLAM"
[COLOR=Red]'Aşağıdaki kodları yeni açılan çalışma kitabının ThisWorkbook yada BuÇalışmaKitabı alanına nasıl yazarız.
' Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'Rem Üzerine tıklanılan çalışma sayfasından bir öncekinin adı
'' ŞABLON değil ve 01 ile başlamıyorsa tıklanılan sayfaya girişe izin verme
'' ve önceki sayfaya git.
' Dim wksACT As Excel.Worksheet
' Dim wksONC As Excel.Worksheet
' Dim rngRPR As Excel.Range
'
' Set wksACT = ThisWorkbook.ActiveSheet
'
' If wksACT.Index = 1 Then GoTo isleyissonu
' If Left(wksACT.Name, 2) = "01" Then GoTo isleyissonu
' If wksACT.Name = "SABLON" Then GoTo isleyissonu
'
' Set wksONC = ThisWorkbook.Worksheets(wksACT.Index - 1)
'
' If wksONC.Range("L5").Text = "" Then
' MsgBox "Lütfen " & wksONC.Name & " adlı sayfada Rapor numarasını giriniz."
' wksONC.Select
' Range("L5").Select
' End If
'
'isleyissonu:
' Set wksACT = Nothing
' Set wksONC = Nothing
'End Sub[/COLOR]
'
End Sub