Tarih gizleme

[policeman]

Hücrede yazılı olan tarih biçimli verinin bazı bölümlerini gizleyebilirmiyiz?..
Örneğin 01.01.2013 olan tarih ##.##.2013 haline nasıl getirilebilir?
Saygılarımla..

 

[Huseyinkis]

Hücrede yazılı olan tarih biçimli verinin bazı bölümlerini gizleyebilirmiyiz?..
Örneğin 01.01.2013 olan tarih ##.##.2013 haline nasıl getirilebilir?
Saygılarımla..

Ekteki dosayı inceleyin hücre biçimlendirme ile yapılmıştır.

 

[policeman]

Teşekkürler..

 

[policeman]

Hücre biçimlendirme ile istediğim sonucu aldım ve tabloma uyguladığımda da sorun çıkmadı ama bulunduğu satırı excelden worde aktardığımda göründüğü gibi (##.##.2013) değil normal (01.01.2013) aktarıyor.
Worde aktarırkende gizli göründüğü şekilde nasıl aktarabilirim?

 

[Huseyinkis]

Word programına nasıl aktarıyorsunuz?

 

[policeman]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("f2:f" & [f65536].End(3).Row)) Is Nothing Then
If Target <> "" Then
Cancel = True
Application.ScreenUpdating = False
Set wd = CreateObject("Word.Application")
Set wddoc = wd.Documents.Add(DocumentType:=0)
wd.Visible = True
For x = 6 To 21
metin = metin & Chr(10) & Cells(1, x) & ": " & Cells(Target.Row, x)
Next
With wd.Selection.PageSetup
.PageWidth = wd.CentimetersToPoints(21)
.PageHeight = wd.CentimetersToPoints(14.8)
End With
wd.Selection = metin
yol_ds = ThisWorkbook.Path & "\" & Cells(Target.Row, 8) & " " & Cells(Target.Row, 7) & " - " & Cells(Target.Row, 6) & ".doc"
wddoc.SaveAs yol_ds
wddoc.Application.Quit
MsgBox "Aktarma tamamlanmıştır.", vbInformation, "xxx xxx"
End If
End If

End Sub
------------------
Yukarıdaki makro ile aktarıyorum..

 

[Korhan Ayhan]

Merhaba,

Hüseyin beyin önerdiği biçimlendirmeyi yaptıktan sonra döngü içindeki bölümü aşağıdaki gibi değiştirip deneyin.

Cells(1, x)[COLOR="Red"].Text[/COLOR]

Böylece hücredeki görünüm ne ise aktarırkende o şekilde görünecektir.

 

[policeman]

Teşekkürler hocam..
İyiki varsın excel.web.tr..

 

[policeman]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("f2:f" & [f65536].End(3).Row)) Is Nothing Then
If Target <> "" Then
Cancel = True
Application.ScreenUpdating = False
Set wd = CreateObject("Word.Application")
Set wddoc = wd.Documents.Add(DocumentType:=0)
wd.Visible = True
For x = 6 To 21
metin = metin & Chr(10) & Cells(1, x).Text & ": " & Cells(Target.Row, x)
Next
With wd.Selection.PageSetup
.PageWidth = wd.CentimetersToPoints(21)
.PageHeight = wd.CentimetersToPoints(14.8)
End With
wd.Selection = metin
yol_ds = ThisWorkbook.Path & "\" & Cells(Target.Row, 8) & " " & Cells(Target.Row, 7) & " - " & Cells(Target.Row, 6) & ".doc"
wddoc.SaveAs yol_ds
wddoc.Application.Quit
MsgBox "Aktarma tamamlanmıştır.", vbInformation, "xxx xxx"
End If
End If

End Sub
--------------
Dediğiniz gibi yaptım ama değişen bir şey olmadı hocam..
Acaba yanlış yeremi uyguladım?!..

 

[policeman]

Hocam tekrar teşekkürler..
dediğiniz değişikliği devamınada yapınca oldu..
Saygılarımla..