• DİKKAT

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

Rapor oluşturmak hakkında

Y

yesimgurol

Katılım
8 Aralık 2011
Mesajlar
964
Excel Vers. ve Dili
Excel 2016,32bit
Merhabalar,
Mevcut hasta listemdeki hastalarım için her hastaya özel belirli bir rapor formatı üzerinden rapor oluşturuyorum tek tek..Acaba bu yaptığım işlemi makro ile yapmak mümkün müdür?
Ekteki dosyamda RAPOR sayfasında açıklamaya çalıştım,umarım ne istediğimi anlatabilmişimdir:-(
Kısaca anlatacak olur isem;
Lİste de hasta bilgilerim mevcut bir adet de Rapor formatım var.
Listede belirli bilgileri alıp rapor formatına geçiriyorum,farklı kaydet yaparak hasta için rapor oluşturuyorum kaydediyorum ve aynı zamanda oluşturduğum bu raporu PDF e çeviriyorum ve hasta adı ile yeni klasör açıp bu raporları o klasörün içine atıyorum.Amaç her hastam için klasör oluşturmak.
Hastalarım çok olduğu için her hasta için bu işlemleri tek tek yapmak zorundayım.
Acaba bu işlemleri daha kolay yapmak için daha hızlı bir yol arayışındayım. Fikir yada kolaylık olması açısından düşünceleriniz önemli benim için.Şimdiden teşekkür ederim.
 

Ekli dosyalar

İdris Bey,çok güzel çalışmalar evet belirlenen sıra numaraları istediğim gibi yalnız inanın kodlar konusunda bilgi düzeyim az:-(
 
En azından excel ve PDF olarak raporları yapabilsek:-(
 
yesimgurol' Alıntı:
Merhabalar,
Mevcut hasta listemdeki hastalarım için her hastaya özel belirli bir rapor formatı üzerinden rapor oluşturuyorum tek tek..Acaba bu yaptığım işlemi makro ile yapmak mümkün müdür?
Ekteki dosyamda RAPOR sayfasında açıklamaya çalıştım,umarım ne istediğimi anlatabilmişimdir:-(
Kısaca anlatacak olur isem;
Lİste de hasta bilgilerim mevcut bir adet de Rapor formatım var.
Listede belirli bilgileri alıp rapor formatına geçiriyorum,farklı kaydet yaparak hasta için rapor oluşturuyorum kaydediyorum ve aynı zamanda oluşturduğum bu raporu PDF e çeviriyorum ve hasta adı ile yeni klasör açıp bu raporları o klasörün içine atıyorum.Amaç her hastam için klasör oluşturmak.
Hastalarım çok olduğu için her hasta için bu işlemleri tek tek yapmak zorundayım.
Acaba bu işlemleri daha kolay yapmak için daha hızlı bir yol arayışındayım. Fikir yada kolaylık olması açısından düşünceleriniz önemli benim için.Şimdiden teşekkür ederim.
Genişletmek için tıkla ...

Userform1 e ait kod:

Kod: 
Private Sub CommandButton1_Click()

Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")
bas = TextBox1.Text + 1
bit = TextBox2.Text + 1


uzanti = fL.GetExtensionName(ThisWorkbook.FullName)
Sayfa_Adı = "RAPOR" 'ActiveSheet.Name

'-------------------------------
Dim FileFormatNum As Long

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Dim Sourcewb As Workbook
Set Sourcewb = ActiveWorkbook

If uzanti = "xls" Then
FileFormatNum = -4143
ElseIf uzanti = "xlsm" Then
FileFormatNum = 52
ElseIf uzanti = "xlsx" Then
FileFormatNum = 51
ElseIf uzanti = "xlsb" Then
FileFormatNum = 50
Else
FileFormatNum = 56
End If


For i = bas To bit

dosya_adi = Sheets("LİSTE").Cells(i, "c").Value


Klasor = ActiveWorkbook.Path & "\" & dosya_adi
If CreateObject("Scripting.FileSystemObject").FolderExists(Klasor) = False Then
MkDir Klasor
End If

say = fL.GetFolder(Klasor).Files.Count + 1

Sheets("RAPOR").Cells(12, "c").Value = Sheets("LİSTE").Cells(i, "c").Value
Sheets("RAPOR").Cells(13, "c").Value = Sheets("LİSTE").Cells(i, "e").Value
Sheets("RAPOR").Cells(14, "c").Value = Sheets("LİSTE").Cells(i, "g").Value
Sheets("RAPOR").Cells(15, "c").Value = Sheets("LİSTE").Cells(i, "f").Value
Sheets("RAPOR").Cells(16, "c").Value = Format(Now, "dd.mm.yyyy")

Sheets("RAPOR").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Klasor & "\" & dosya_adi & say & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

Sheets("RAPOR").Copy
ActiveSheet.DrawingObjects.Delete
For Each Component In ActiveWorkbook.VBProject.VBComponents
If Component.Type <> 100 Then
ActiveWorkbook.VBProject.VBComponents.Remove Component
Else
Set modul = Component.CodeModule
modul.DeleteLines 1, modul.CountOfLines
End If
Next

say = fL.GetFolder(Klasor).Files.Count + 1

ActiveWorkbook.SaveAs Klasor & "\" & dosya_adi & say & "." & uzanti, FileFormat:=FileFormatNum
ActiveWorkbook.Close SaveChanges:=False
With Application
.ScreenUpdating = True
.EnableEvents = True
End With

Next i

MsgBox "işlem tamam"
End Sub
 
Halit Bey,çok teşekkür ederim ilginize..Kodları ekledim yalnız şu uyarıyı aldım,
"Run-tıme erorr 1004"
Vısual basıc projesıne programlı olarak erişim güvenli değil ,uyarısı yazan pencerenin altında Debug dediğimde de,alttaki kod satırı sarı renkli oluyor.
Kod: 
For Each Component In ActiveWorkbook.VBProject.VBComponents

Ben mi hatalı bir işlem yaptım acaba:-(
 
yesimgurol' Alıntı:
Halit Bey,çok teşekkür ederim ilginize..Kodları ekledim yalnız şu uyarıyı aldım,
"Run-tıme erorr 1004"
Vısual basıc projesıne programlı olarak erişim güvenli değil ,uyarısı yazan pencerenin altında Debug dediğimde de,alttaki kod satırı sarı renkli oluyor.
Kod: 
For Each Component In ActiveWorkbook.VBProject.VBComponents

Ben mi hatalı bir işlem yaptım acaba:-(
Genişletmek için tıkla ...

Sorunu form da yaptığım araştırma ile çözdüm.Güven merkezinde VBA projelerine güven kutucuğunu işaretledim.:mutlu::mutlu: yeni bir şey öğrenmiş oldum.
 
Halit bey,çok çok teşekkür ederim.:bravo::dua2: Tam istediğim gibi olmuş.:mutlu::mutlu:
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst