Çözüldü Word'de Soru numarası verme belgelere ayırma

[tukayf]

Merhabalar değerli hocalarım.
Özellikle Sn. Caylak hocam.
Ekteki excel ile wordden yazıyı alıp soru numarası verip tekrar her 20 soru bir belge olacak şekilde Word e aktarıyoruz.
Alttaki kodlar ise Word dosyasında çalıştırıldığında Word deki arkaplan rengini, yazı rengi yapıyor.

Bu durumdan sonra
Sayfa1 e alan kodlar renkli olarak alıyor.
Sayfa2 ye aktaran kodlar da ise renk yok. Sayfa2 ye ve Worde renkli olarak aktarabilmek mümkün müdür.
Ya da Word e cevap anahtarıyla birlikte aktarabilmek.

Dim ArananRenk As String
Dim YeniRenk As String
Dim myDoc As Document
Dim myRng As Range

Application.ScreenUpdating = False
Set myDoc = ActiveDocument
ArananRenk = wdRed
YeniRenk = wdAuto

With Selection
.HomeKey Unit:=wdStory
With Selection.Find
.Highlight = True

Do While .Execute
If Selection.Range.HighlightColorIndex = ArananRenk Then
Set myRng = Selection.Range
myRng.HighlightColorIndex = YeniRenk
myRng.Font.ColorIndex = 6
Selection.Collapse wdCollapseEnd
End If
Loop
End With
End With
Application.ScreenUpdating = True
Set myDoc = Nothing
End Sub

 

[Caylak]

İnceleyin

 

[tukayf]

Hocam tekrardan merhabalar. Çok emek verdiniz Allah razı olsun.
Dosya içerisine yazdım.
Excele alıp soru numarası verdirip (butonları oluşturdum.) renkli ya da arka fonlu şekilde her 20 soruda tekrar belgelere bölsem yeterli şimdilik. cevap anahtarını manuel olarak da idare edebiliriz. Sonrası Allah kerim.

 

[Kuşdili]

Cevap anahtarı için:

Değerli Misafirimiz İçeriği Görebilmek İçin Üyemiz İseniz Giriş Yap'ın Ya da Üye Ol'un.

 

[tukayf]

Sn. Kuşdili yanıt için teşekkürler. Ama Worde renkli ve numaraları alamadım henüz. Sanırım o nedenle numara ve cevap anahtarı oluşturmadı sizin kod. Sadece tablo oluşturdu.

 

[Kuşdili]

Örnek dosyanız ekte.

 

[tukayf]

Sn. Kuşdili gayet güzel çalışıyormuş ben renk numarasını tutturamamışım sanırım.
Sn. kuş dili Sorulara sıra numarasını elle mi verdiniz. Kodla çözebildiniz mi o kısmı. O kısmı çözdüyseniz bütün sorunum çözülmüş oluyor.

 

[Kuşdili]

Sıra numarasını kod kullanmadan wordün kendi özelliği olan "Numaralandırma" ile verdim. Ama kod ile de verilebilir.

 

[tukayf]

Sıra numarasını kod kullanmadan wordün kendi özelliği olan "Numaralandırma" ile verdim. Ama kod ile de verilebilir.

Hocam bu örnek için sıra numarasını Word ile verebiliyoruz ancak çok fazla farklı örnek var diğer dosyaları word ile otomatik numaralandıramıyorum. Çok fazla sorun çıkarıyor.

 

[Kuşdili]

Farklı örnekleri görebilir miyiz?

 

[tukayf]

Sn. Kuşdili farklı örnek çok fazla ve çok sayıda farklı kullanıcı tarafından oluşturulduğu için sayfa boşlukları kenar boşlukları madde işaretleri ve sıralandırmalar çok farklı. O nedenle farklı örnek ekleyemedim. Ancak bir kaç farklı örnek eklemeden kırmızı arka planın kodu nedir acaba. Bütün dosyalarda kırmızı arka plan cevaplar.

 

[Kuşdili]

Renkler ve numaraları şunlar:
Name Value Description
wdAuto 0 Automatic color. Default; usually black.
wdBlack 1 Black color.
wdBlue 2 Blue color.
wdBrightGreen 4 Bright green color.
wdByAuthor -1 Color defined by document author.
wdDarkBlue 9 Dark blue color.
wdDarkRed 13 Dark red color.
wdDarkYellow 14 Dark yellow color.
wdGray25 16 Shade 25 of gray color.
wdGray50 15 Shade 50 of gray color.
wdGreen 11 Green color.
wdNoHighlight 0 Removes highlighting that has been applied.
wdPink 5 Pink color.
wdRed 6 Red color.
wdTeal 10 Teal color.
wdTurquoise 3 Turquoise color.
wdViolet 12 Violet color.
wdWhite 8 White color.
wdYellow 7 Yellow color.
------------------------------------------------------------
İki örnek kullanım:
If par.Range.Words(1).HighlightColorIndex = 6 Then 'Kırmızı renkli ise demek
If par.Range.Words(1).HighlightColorIndex > 0 Then 'Bu daha genel renk varsa demektir...

 

[tukayf]

Sub WordYarat()
Dim YeniDosya As Object
Set YeniDosya = CreateObject("Word.Application")
Set Sayfa = ThisWorkbook.Worksheets("Sayfa1")
ss = Sayfa.Range("A" & Rows.Count).End(xlUp).Row

With YeniDosya
.Visible = True
.Activate
.Documents.Add
With .Selection
For i = 1 To ss
Text = Sayfa.Cells(i, 1) & " " & Sayfa.Cells(i, 2)
If Text = "" Then Text = " "
.TypeText Text
.TypeParagraph
Next
End With
End With
MsgBox "Dosyayı kaydedip kapatmayı unutmayınız", vbInformation + vbOKOnly, ""
End Sub

Sn. Caylak'ın bu kodu excelden Worde aktarıyor ancak renkli şekilde aktarmıyor. Bu koda renkli şekilde aktarım ekleyebilirsek sonrasında sizin cevap anahtarıyla sanırım bu işten kurtulabiliyorum artık.
Renkler için de teşekkürler. Hemen deniyorum.

 

[tukayf]

Kırmızı font için 6 ve 11 i denedim. Numaralandırmayı otomatik yaptım ama cevap anahtarını aldıramadım.

 

[Caylak]

Merhabalar;
Ekli dosya ile adım adım tüm işlemlerinizi gerçekleştirebilirsiniz.
Deneyin

 

[tukayf]

Hocam Allah ne muradınız varsa versin. Şu an harika gözüküyor deneyip dönüş yapacağım.

 

[tukayf]

Bütün işlemleri yapıyor. Ancak bu satırda hata veriyor. Bu şekilde de işimi görür ancak düzeltebilirsek harika olur.

 

[Caylak]

Merhaba,
Hatanın sebebi dosyalarınızın kaydedileceği klasörün içerisinde aynı adlı (Grup 1.docx veya Grup 2.dock...vb) başka bir dosya olması ihtimalinden olabilir.

 

[tukayf]

Merhaba,
Hatanın sebebi dosyalarınızın kaydedileceği klasörün içerisinde aynı adlı (Grup 1.docx veya Grup 2.dock...vb) başka bir dosya olması ihtimalinden olabilir.

Olumsuz hocam boş dosyaya kayıt yaptırsam da aynı hatayı veriyor. Ofis sürümünden kaynaklı olabilir mi acaba.

 

[Caylak]

Olumsuz hocam boş dosyaya kayıt yaptırsam da aynı hatayı veriyor. Ofis sürümünden kaynaklı olabilir mi acaba.

Bende aynı yerde dosya olmasına rağmen yine de hiç hatasız çalışıyor, Kütüphane olarak Microsoft.Word.16.0 Object Library kullanıyorsunuz siz, bende olmadığı için ben 15.0 yükleyip kullanıyorum. Problemsiz çalışıyor.