AccessTr.neT

Sayfalar: 1 2 3

Sn kübrashn;
Asagida ki kodu deneyin.
private Declare Function Calistir Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As String, ByVal lpszFile As String, _
ByVal lpszParams As String, ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
Private Const SW_HIDE = 0
Private Const SW_SHOWNORMAL = 1
Private Const SW_PRINTNORMAL = 2
Public Function Kostur(DosyaAdi As String, Optional DosyaIslem As String = "print") As Boolean
Dim CalIslem As Long
CalIslem = Calistir(0&, DosyaIslem, DosyaAdi, vbNullString, vbNullString, IIf(DosyaIslem = "print", SW_HIDE, SW_PRINTNORMAL))
If CalIslem <= 32 Then
MsgBox CalIslem & "-->" & DosyaAdi
Kostur = False
MsgBox "Hatali " & DosyaIslem & " " & DosyaAdi & vbCrLf & vbCrLf & "Islem yapilamadi.", vbExclamation
Else
Kostur = True
End If
End Function
Private Sub Yaz_Click()
Dim evn As Object, klasor As Object, dosya As Object, yol, Tip As Variant, Msg, Yer
Msg = MsgBox("Yazdýrmak Ýstediðinizden Emin misiniz?", vbYesNo + vbQuestion, "Çýkýþ")
Yer = App.Path
Tip = Array("Application", "Bitmap image")
If Msg = vbYes Then
Set evn = CreateObject("shell.application")
yol = CreateObject("scripting.filesystemobject").getfolder(Yer)
Set klasor = evn.Namespace(yol)
Set dosya = klasor.Items()
For Each dosya In dosya
If Mid(dosya.Type, 1, 9) = "Microsoft" Then
Call Kostur(Yer & "\" & dosya.Name, "Print")
Me.Mesaj.Text = dosya
Me.Mesaj.Refresh
End If
Next
Set dosya = Nothing: Set klasor = Nothing
Set yol = Nothing: Set evn = Nothing
End
ElseIf Msg = vbNo Then
Exit Sub
End If
End Sub

Cümleten hayirli kandiller. Sizinde kandiliniz mübarek olsun Ahmet Bey. Însallah yarin deneyip yazacagim. Hayirli geceler.

Hayırlı sabahlar Hayırlı Cumalar arkadaşlar.
Ahmet Bey
"Me.Mesaj.Text = dosya" bu kısımda hata veriyor. Ayrıca form ve proje ektedir.
Ya bu türlü yapamadım kolay yaparım diye düşünmüştüm. İlk başladığım noktada arkadaşlar uygulamanın form üzerinden hangi dosya nın içindeki pdf leri yazdırmak istiyorsunuz? diye sorsa öyle devam etse dediklerinde ben uygulamanın içinde bulunduğu klasörün içindekileri yazdırması daha kolay demiştim, yanılmışım. Img-cray

(

Sn kübrashn,
Kodlarda ki nesneleri olusturma ile kodlar calisacaktir.

Kod:
Private Declare Function Calistir Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As String, ByVal lpszFile As String, _

ByVal lpszParams As String, ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long

Private Const SW_HIDE = 0

Private Const SW_SHOWNORMAL = 1

Private Const SW_PRINTNORMAL = 2

Dim YazdirmaSeceneci As Long

Public Function Kostur(DosyaAdi As String, Optional DosyaIslem As String = "print") As Boolean

Dim CalIslem As Long

CalIslem = Calistir(0&, DosyaIslem, DosyaAdi, vbNullString, vbNullString, IIf(DosyaIslem = "print", SW_HIDE, SW_SHOWNORMAL))

  If CalIslem <= 32 Then

    Kostur = False

    MsgBox "Hatali " & DosyaIslem & " " & DosyaAdi & vbCrLf & vbCrLf & "Islem yapilamadi.", vbExclamation

  Else

    Kostur = True

  End If

End Function

Private Sub Form_Load()

Me.KlasorAdi.Text = App.Path

End Sub

Private Sub KlasorAdi_DblClick()

WinPen.ShowOpen

Me.KlasorAdi.Text = Mid(WinPen.FileName, 1, Len(WinPen.FileName) - InStr(1, StrReverse(WinPen.FileName), "\"))

End Sub

Private Sub KlasorAdi_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Me.Mesaj.Caption = "Cift tiklayip, klasor degistirebilirsiniz."

End Sub

Private Sub KlasorSec_Change()

Me.KlasorAdi.Text = Me.KlasorSec.Path

End Sub

Private Sub KlasorSec_Click()

Me.KlasorAdi.Text = Me.KlasorSec.Path

End Sub

Private Sub KlasorSec_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Me.Mesaj.Caption = "Klasoru secmek icin cift tiklayiniz."

End Sub

Private Sub Secmece_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Me.Mesaj.Caption = "Yazdirilacak dosya tipini secin."

End Sub

Private Sub Yaz_Click()

Dim evn As Object, klasor As Object, dosya As Object, yol, Tip As Variant, Msg, Yer

Dim SW, Yz As Long

Msg = MsgBox("Yazdýrmak Ýstediðinizden Emin misiniz?", vbYesNo + vbQuestion, "Çýkýþ")

Tip = Array("", "pdf", "xls", "doc", "ppt", "txt") '********* DOSYA UZANTILARINI BURAYA YAZDIR ************

If Msg = vbYes Then

Yer = Me.KlasorAdi.Text

Set evn = CreateObject("shell.application")

yol = CreateObject("scripting.filesystemobject").getfolder(Yer)

Set klasor = evn.Namespace(yol)

Set dosya = klasor.Items()

    SW = 1

    For Each dosya In dosya

        For SW = IIf(YazdirmaSeceneci = 0, 1, YazdirmaSeceneci) To IIf(YazdirmaSeceneci = 0, 5, YazdirmaSeceneci) '********* DOSYA UZANTILARINa gore 5 + veya - ************

            If Tip(SW) = Mid(dosya.Name, (InStr(1, dosya.Name, ".") + 1), 3) Then Yz = 1: Exit For Else Yz = 0

        Next SW

        If Yz = 1 Then

            Call Kostur(Yer & "\" & dosya.Name, "Print")

            Me.Mesaj.Caption = dosya

            Me.Mesaj.Refresh

        End If

        Yz = 0

    Next dosya

    Set dosya = Nothing: Set klasor = Nothing: Set yol = Nothing: Set evn = Nothing:

    Me.Mesaj.Caption = "YAZDIRMA ISLEMI TAMAMLANDI."

ElseIf Msg = vbNo Then

    Exit Sub

End If

If YazdirmaSeceneci > 0 Then Me.Controls("Option" & YazdirmaSeceneci).Value = False

YazdirmaSeceneci = 0

End Sub

Private Sub Yaz_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Me.Mesaj.Caption = "Klasoru yazdirmak icin tiklayin."

End Sub

Private Sub Option1_Click()

YazdirmaSeceneci = Me.Option1.Tag

Me.Mesaj.Caption = "Pdf turunde ki dosyalar yazdirilacak"

End Sub

Private Sub Option2_Click()

YazdirmaSeceneci = Me.Option2.Tag

Me.Mesaj.Caption = "Excel turunde ki dosyalar yazdirilacak"

End Sub

Private Sub Option3_Click()

YazdirmaSeceneci = Me.Option3.Tag

Me.Caption = Me.Option3.Tag

Me.Mesaj.Caption = "Word turunde ki dosyalar yazdirilacak"

End Sub

Private Sub Option4_Click()

YazdirmaSeceneci = Me.Option4.Tag

Me.Mesaj.Caption = "Power Point turunde ki dosyalar yazdirilacak"

End Sub

Private Sub Option5_Click()

YazdirmaSeceneci = Me.Option5.Tag

Me.Mesaj.Caption = "Metin turunde ki dosyalar yazdirilacak"

End Sub

[attachment=22520]

Hayırlı akşamlar Ahmet Bey. Bugün akşama kadar proje kısmını oluşturmayı denedim başaramadım. Açlık başıma vurdu sanırım. İftardan sonra denemeye devam edeceğim. Umarım kızmazsınız bana. Hakkınızı helal edin.
Ayrıca
Basic yülkü olmayan bir bilgisayarda çalıştırmayı denedim. Project1 Component COMDLG32.OCX or one of its dependencies not correctly registered: a file missing or invalid hatası verdi.

Çok teşekkürler

Sn kübrashn;
ALLAH kabul etsin. Ek'te ki uygulamada dll ile formlara bakabilirsiniz. Once ki mesajda ki exe'yi hic calistiramadiniz mi? [attachment=22544]

Sayfalar: 1 2 3

KulAhmet

kübrashn

kübrashn

KulAhmet

kübrashn

KulAhmet