• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

a.xls den b.xls nin sfTOPLAM adlı çalışma sayfasının modülüne kod yazmak?

  • Konbuyu başlatan Konbuyu başlatan hsayar
  • Başlangıç tarihi Başlangıç tarihi
H

hsayar

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Aşağıdaki kodlarda (yeşil ile işaretli) yeni oluşturduğum çalışma kitabının modTOPLAM adlı modüle kod yazabiliyorum.

Ancak istediğim vba ekranın PROPORTIES ekranında Sayfa32 (her zaman değişir) olan ancak sekme adı TOPLAM olan (sabit) sayfanın koduna nasıl yazacağız?

Kod: 
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
  
  Dim wkbYKTP     As Excel.Workbook
  Dim wkbBKTP     As Excel.Workbook
  Dim wksSSYF     As Excel.Worksheet
  Dim wksYSYF     As Excel.Worksheet
  Dim xvbPROJ     As Object 'Excel.Workbook
  
  Dim dTARIH      As Variant
  Dim intYKCS     As Integer
  Dim intSNGN     As Integer
  Dim strYADI     As String
  Dim lngLINE     As Long
  
    dTARIH = InputBox("İşlem Yapacağınız Ayın ilkgününü aa/gg/yyyy şeklinde giriniz!")
    If IsDate(dTARIH) = False Then
      MsgBox "girilen değer tarih değil" 'denetim ekle
      GoTo endProc
    End If
  
  Set wkbYKTP = Workbooks.Add
  Set wkbBKTP = ThisWorkbook
  Set wksSSYF = wkbBKTP.Worksheets("SABLON")
 
    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Ş"
      GoTo endProc
    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(i & "." & Month(dTARIH) & "." & Year(dTARIH), "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"
      
      
Rem Yeni Çalışma Kitabının ThisWorkbook Modülüne kod yaz...
    wkbYKTP.Activate
    
'    Set xvbPROJ = wkbYKTP.VBProject.VBComponents("BuÇalışmaKitabı")
    Set xvbPROJ = wkbYKTP.VBProject.VBComponents(1)
    lngLINE = 0
      With xvbPROJ.CodeModule
         'Sorun2: Daha evvel projede hiç satır yoksa lngLINE değeri 0 olsun
  '      lngLINE = .CountOfLınes
        .InsertLines lngLINE + 1, "Private Sub Workbook_SheetActivate(ByVal Sh As Object)"
        .InsertLines lngLINE + 2, "Rem Excel.web.tr/hsayar tarafından  hazırlanan makro ile ACİL MÜDAHALE PROGRAMI ŞABLON dosyasından  oluşturulmuştur."
        .InsertLines lngLINE + 4, "Dim wksACT    As Excel.Worksheet"
        .InsertLines lngLINE + 5, "Dim wksONC    As Excel.Worksheet"
        .InsertLines lngLINE + 6, "Dim rngRPR    As Excel.Range"
        .InsertLines lngLINE + 7, ""
        .InsertLines lngLINE + 8, "Set wksACT = ThisWorkbook.ActiveSheet"
        .InsertLines lngLINE + 9, ""
        .InsertLines lngLINE + 11, "with wksACT"
        .InsertLines lngLINE + 12, "  If .Index = 1 Then GoTo isleyissonu"
        .InsertLines lngLINE + 13, "  If Left(.Name, 2) = " &  Chr(34) & "01" & Chr(34) & " Then GoTo isleyissonu"
        .InsertLines lngLINE + 14, "  If .Name = " & Chr(34) & "SABLON" & Chr(34) & " Then GoTo isleyissonu"
        .InsertLines lngLINE + 15, "end with"
        .InsertLines lngLINE + 16, ""
        .InsertLines lngLINE + 17, "Set wksONC = ThisWorkbook.Worksheets(wksACT.Index - 1)"
        .InsertLines lngLINE + 18, ""
        .InsertLines lngLINE + 19, "  with wksONC"
        .InsertLines lngLINE + 20, "    If .Range(" & Chr(34) &  "L5" & Chr(34) & ").Text =" & Chr(34) & Chr(34) & "  Then"
        .InsertLines lngLINE + 21, "      MsgBox " & Chr(34) &  "Lütfen " & Chr(34) & Chr(38) & Space(1) & ".Name" &  Space(1) & Chr(38) & Chr(34) & " adlı sayfada Rapor  numarasını giriniz." & Chr(34)
        .InsertLines lngLINE + 22, "      .Select"
        .InsertLines lngLINE + 23, "      Range(" & Chr(34) & "L5" & Chr(34) & ").Select"
        .InsertLines lngLINE + 24, "    End If"
        .InsertLines lngLINE + 25, "  end with"
        .InsertLines lngLINE + 26, ""
        .InsertLines lngLINE + 28, "isleyissonu:"
        .InsertLines lngLINE + 29, ""
        .InsertLines lngLINE + 30, "Set wksACT = Nothing"
        .InsertLines lngLINE + 31, "Set wksONC = Nothing"
        .InsertLines lngLINE + 33, ""
        .InsertLines lngLINE + 34, ""
        .InsertLines lngLINE + 35, "End Sub"
      End With
    Set xvbPROJ = Nothing
    

Rem Yeni Çalışma Kitabında standartmodül oluştur ve adını modTOPLAM yap
    Set xvbPROJ = wkbYKTP.VBProject.VBComponents.Add(vbext_ct_StdModule)
    xvbPROJ.Name = "modTOPLAM"
    lngLINE = 0
      With xvbPROJ.CodeModule
        .InsertLines lngLINE + 1, "Sub AY_TOPLAMI_AL()"
        .InsertLines lngLINE + 2, "Rem Excel.web.tr/hsayar tarafından  hazırlanan makro ile ACİL MÜDAHALE PROGRAMI ŞABLON dosyasından  oluşturulmuştur."
        .InsertLines lngLINE + 3, "REM Bu Çalışma Kitabındaki Günlük sayfalarının toplamını alır."
        .InsertLines lngLINE + 5, "Dim intSYF As Integer"
        .InsertLines lngLINE + 6, "Dim intSAT As Integer"
        .InsertLines lngLINE + 7, "Dim intSUT As Integer"
        .InsertLines lngLINE + 8, ""
        .InsertLines lngLINE + 10, "  Range(Cells(13, 9), Cells(28, 13)).ClearContents"
        .InsertLines lngLINE + 11, "  Range(Cells(33, 3), Cells(37, 5)).ClearContents"
        .InsertLines lngLINE + 12, ""
        .InsertLines lngLINE + 13, "  For intSYF = 1 To Sheets.Count - 1"
        .InsertLines lngLINE + 14, "    For intSUT = 9 To 13"
        .InsertLines lngLINE + 15, "      For intSAT = 13 To 28"
        .InsertLines lngLINE + 16, "        Cells(intSAT, intSUT) =  Cells(intSAT, intSUT) + Sheets(intSYF).Cells(intSAT, intSUT)"
        .InsertLines lngLINE + 17, "      Next intSAT"
        .InsertLines lngLINE + 18, "    Next intSUT"
        .InsertLines lngLINE + 19, ""
        .InsertLines lngLINE + 20, "    For intSUT = 3 To 5"
        .InsertLines lngLINE + 21, "      For intSAT = 33 To 37"
        .InsertLines lngLINE + 22, "        Cells(intSAT, intSUT) =  Cells(intSAT, intSUT) + Sheets(intSYF).Cells(intSAT, intSUT)"
        .InsertLines lngLINE + 23, "      Next intSAT"
        .InsertLines lngLINE + 24, "    Next intSUT"
        .InsertLines lngLINE + 25, "  Next intSYF "
        .InsertLines lngLINE + 26, "End Sub"
      End With
    Set xvbPROJ = Nothing
    wkbYKTP.Save
    
endProc:
  Set wkbYKTP = Nothing
  Set wkbBKTP = Nothing
  Set wksSSYF = Nothing
  Set wksYSYF = Nothing

Application.ScreenUpdating = True
End Sub
' Set xvbPROJ = wkbYKTP.VBProject.VBComponents("BuÇalışmaKitabı")
Set xvbPROJ = wkbYKTP.VBProject.VBComponents(1)

satırında dil ve versiyon farkına bağlı olarak isim değişiyor ben denemeleirmde indexno olarak 1 buldum bu doğru mudur?


lngLINE = .CountOfLınes
satırında modulde başka kod olmadığı için hata veriyor, modülde hiç kod yoksa denetimi yapılıp lngline değeri 0 yada kaçsa o olsun.

' Set xvbPROJ = wkbYKTP.VBProject.VBComponents("BuÇalışmaKitabı")
yine bu satırda sekmeadı TOPLAM olan sayfayı atamak istersek nasıl olmalı.
bazen Sayfa11(toplam), sayfa10(15.01.2008), sayfa8(1111) gibi isimlendirilmişse ben excel sekem adı olan () değere atamak istiyorum.
 
Son düzenleme:
toplam adlı çalışma sayfasının kod bölümüne nasıl ekleme yapacağımı buldum :)

Ancak Thisworkbokk ifadesi 2007 de çalışıyor. Bu çalışma kitabı 2010 da yazıyor. index 1 değince o da 2010 dfa çalışıyor ancak 2007 de çalışmıyor. Dil ve versiyon farkı olmaksızın çalışacak ifade nasıl olmalı?
Kod: 
'................
Rem Yeni Çalışma Kitabında oluşan TOPLAM isimli çalışma sayfasına kod yaz.
[B][COLOR=DarkOliveGreen]     strPROJ = wkbYKTP.Worksheets("TOPLAM").CodeName
     Set xvbPROJ = wkbYKTP.VBProject.VBComponents(strPROJ)[/COLOR][/B]
     lngLINE = 0
      With xvbPROJ.CodeModule
        .InsertLines lngLINE + 1, "Sub AY_TOPLAMI_AL()"
        .InsertLines lngLINE + 2, "Rem Excel.web.tr/hsayar tarafından hazırlanan makro ile ACİL MÜDAHALE PROGRAMI ŞABLON dosyasından oluşturulmuştur."
        .InsertLines lngLINE + 3, "REM Bu Çalışma Kitabındaki Günlük sayfalarının toplamını alır."
        .InsertLines lngLINE + 5, "Dim intSYF As Integer"
'.....................
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst