• DİKKAT

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

Tablolu Sayfa İçinde Otomatik Sıra No Verme

B

baysevimli

Katılım
13 Eylül 2015
Mesajlar
201
Excel Vers. ve Dili
2010 VBA
Değerli Arkadaşlar Merhaba,

Ekli dosyada upload ettiğim örnek Word dosyasında teklif metinlerim var. Her teklif metninin solunda Teklif numarası ve Karar numarası var. Ben size pratik olması sebebiyle birkaç teklif metni verdim. Benim bazen 100-1500 metnim olabiliyor. İstediğim iki şey var.

1 - Word dosyasında Soldaki Teklif numaralarını en baştan aşağıya doğru sıralı otomatik yazsın; örneğin 1.Teklif, 2. Tekif, 3.Teklif ….. şeklinde. Ama burada önemli bir nokta var bazen ortalardan bir teklifi silebiliyorum sildiğim zamanda otomatik yine en baştan başlayarak sıra numarası versin.

2- Yine Word dosyasında Soldaki Karar No kısımlarını da en baştan aşağıya doğru sıralı numara verecek ama burda da önemli olan şu; en baştan sıralamaya 1,2,3,4,5 diye başlamayacak, benim verdiğim numaradan sonra başlayacak örneğin 0890 numarasını bir alana yazıcam otomatik olarakta kaçtane teklif varsa karar numaralarını 0890 dan başlayarak sıralı numara verecek. Bir önemli nokta daha var ortalardan teklif metni sildiğimde yine sıralamayı otomatik yapacak. Yardımlarınız için teşekkür ederim.

örnek dosya linki aşağıdaki gibidir.

http://dosya.co/qe0f6ucbjvnv/Örnek.docx.html
 
Bu konu ile ilgili 5. ayda bir çalışma yapmışım.
Bu işinizi görmedi mi?

Word dosyasında macro bölümüne yapıştırınız.

Kod: 
Sub Menu()
   Call karar_duzenle
   Call teklif_duzenle
End Sub

Sub karar_duzenle()
  Dim strCellText As String
  Dim uResp As String
  Dim Row As Integer
  Dim Col As Integer
  Dim itable As Table
  say = 0
  For Each itable In ThisDocument.Tables
    karar = ""
    For Row = 1 To itable.Rows.Count
       For Col = 1 To itable.Columns.Count
            kararnumarasi = 0
            karar = ""
            cumle = itable.Cell(Row, Col).Range.Text
            If InStr(cumle, ":") > 0 Then
               kararnumarasi = Val(Mid(cumle, InStr(cumle, ":") + 1, Len(cumle)))
               karar = Mid(cumle, 1, InStr(cumle, ":"))
            End If
            If karar = "KARAR NO:" Then
               If say = 0 Then
                  numarator = kararnumarasi
               Else
                numarator = numarator + 1
                  itable.Cell(Row, Col).Range.Text = "KARAR NO:" & numarator
               End If
               say = say + 1
            End If
       Next
    Next
  Next

End Sub

  
Sub teklif_duzenle()
   Dim strLine As String
   Dim colString As Collection
   Dim intLastLine As Integer
   Dim intLastPage As Integer
   Dim flag As Boolean
   On Error Resume Next
   
   Selection.EndKey Unit:=wdStory
   intLastLine = Selection.Range.Information(wdFirstCharacterLineNumber)
   intLastPage = Selection.Range.Information(wdActiveEndPageNumber)
   
   Set colString = New Collection
   Selection.HomeKey Unit:=wdStory
   flag = True
   While flag = True
     If (Selection.Range.Information(wdFirstCharacterLineNumber) _
         = intLastLine) And intLastPage = _
        Selection.Range.Information(wdActiveEndPageNumber) Then
        flag = False
     End If
     
     Selection.EndKey Unit:=wdLine, Extend:=wdExtend
     cumle = Selection.Range.Text
     numarasiz = Mid(cumle, InStr(cumle, "."), Len(cumle))
     teklif = Mid(cumle, InStr(cumle, ".") + 1, 6)
     If teklif = "TEKLİF" Then
        say = say + 1
        sekil = Selection.Range.Style
        Selection.Range.Text = say & numarasiz
        Selection.Range.Style = sekil
        Selection.EndKey Unit:=wdLine, Extend:=wdExtend
        Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify
        Selection.Font.Grow
        Selection.Font.Bold = wdToggle
     End If

     Selection.MoveDown Unit:=wdLine, Count:=1
     Selection.HomeKey Unit:=wdLine
 Wend

End Sub
 
Sn. Asri,

Öncelikle ilginize teşekkür ederim. 5. Aydan beri maalesef tam çözüm bulamadım. Sizin üstte paylaştığınız kodu tekrar denedim. Çalışıyor ancak sadece 2 hususta eksik var.

1- Tekliflere, ilk tekliften başlayarak 1,2,3,4... vs. diye sıra no veriyor burda sorun yok, ancak, tekliflerin "FUTBOL SAHASI İNŞAATI" konu başlıklarına makroyu çalıştırınca bir boşlukla içeri alıyor. Başlığımın metinle aynı hizada olması gerek.

2- Karar No: kısımlarını ilk karar no dan başlayıp 1,2,3,4... diye sıra no veriyor ama benim karar no alanları ile ilgili istediğim şey şu idi; İlk teklifime ben bir karar no vericem o verdiğim karar nodan sonra 1'er artırıp sayı verecek. Örneğin 108,109,110.... gibi. Makroyu çalıştırdıktan sonra aldığım sonucun ekran görüntüsünü çekip ekte paylaştım. Bu 2 hususu çözebilirsek çok sevinicem. Emekleriniz için çok teşekkür ederim.
 

Ekli dosyalar

  • Untitled.jpg
    Untitled.jpg
    254.4 KB · Görüntüleme: 4
baysevimli' Alıntı:
Sn. Asri,

Öncelikle ilginize teşekkür ederim. 5. Aydan beri maalesef tam çözüm bulamadım. Sizin üstte paylaştığınız kodu tekrar denedim. Çalışıyor ancak sadece 2 hususta eksik var.

1- Tekliflere, ilk tekliften başlayarak 1,2,3,4... vs. diye sıra no veriyor burda sorun yok, ancak, tekliflerin "FUTBOL SAHASI İNŞAATI" konu başlıklarına makroyu çalıştırınca bir boşlukla içeri alıyor. Başlığımın metinle aynı hizada olması gerek.

2- Karar No: kısımlarını ilk karar no dan başlayıp 1,2,3,4... diye sıra no veriyor ama benim karar no alanları ile ilgili istediğim şey şu idi; İlk teklifime ben bir karar no vericem o verdiğim karar nodan sonra 1'er artırıp sayı verecek. Örneğin 108,109,110.... gibi. Makroyu çalıştırdıktan sonra aldığım sonucun ekran görüntüsünü çekip ekte paylaştım. Bu 2 hususu çözebilirsek çok sevinicem. Emekleriniz için çok teşekkür ederim.
Genişletmek için tıkla ...

Karar No: konusunda ilk sıradaki karar no kaç ise diğer karar noları ona göre arttırmaktadır.

ilk Karar No: 200 ise ikinci karar no 201 ve sonrası birer artmaktadır.

1. maddedeki sorunda TEKLİF ile teklifin konusu arasında TAB değilde boşluk olur ise kayma olmuyor.

Not: Ekli dosyaları göremiyorum, site harici link veriniz.
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst