Konu Araçları | Konu Seçenekleri | Gösterim Stili
Tarih
17/04/2015 12:33
Konu Sahibi
kübrashn
Yorumlar
16
Okunma
5123
Konuyu Oyla:
  • Derecelendirme: 4/5 - 1 oy
  • 1
  • 2
  • 3
  • 4
  • 5
KulAhmet

KulAhmet

Üye
72493
Ah.... Ku....
 19
 0
 22
 17/04/2015
0
 Eskişehir
 
 Ofis 2013 64 Bit
 27/06/2019,17:34
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




kübrashn

kübrashn

Aktif Üye
65677
Kü.... Sa....
 28
 18
 81
 05/08/2014
0
 Ankara
 
 -
 07/07/2019,13:05
Cümleten hayirli kandiller. Sizinde kandiliniz mübarek olsun Ahmet Bey. Însallah yarin deneyip yazacagim. Hayirli geceler.



...........
kübrashn

kübrashn

Aktif Üye
65677
Kü.... Sa....
 28
 18
 81
 05/08/2014
0
 Ankara
 
 -
 07/07/2019,13:05
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(



KulAhmet

KulAhmet

Üye
72493
Ah.... Ku....
 19
 0
 22
 17/04/2015
0
 Eskişehir
 
 Ofis 2013 64 Bit
 27/06/2019,17:34
Sn kübrashn,
Kodlarda ki nesneleri olusturma ile kodlar calisacaktir.

Kod:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
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




...........
kübrashn

kübrashn

Aktif Üye
65677
Kü.... Sa....
 28
 18
 81
 05/08/2014
0
 Ankara
 
 -
 07/07/2019,13:05
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



KulAhmet

KulAhmet

Üye
72493
Ah.... Ku....
 19
 0
 22
 17/04/2015
0
 Eskişehir
 
 Ofis 2013 64 Bit
 27/06/2019,17:34
Sn kübrashn;
ALLAH kabul etsin. Ek'te ki uygulamada dll ile formlara bakabilirsiniz. Once ki mesajda ki exe'yi hic calistiramadiniz mi?



...........

Konuyu Okuyanlar: 1 Ziyaretçi

Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
Çözüldü insert into hatası nasıl düzeltilir? necati 8 6.705 27/02/2012, 21:29
Son Yorum: benremix
Çözüldü invalid authorization specification hatası Şeyma462 5 4.287 20/05/2011, 22:39
Son Yorum: ~~KaG~~
Çözüldü Excutenonquerry Hatası ersinyasin 4 2.295 24/04/2011, 10:18
Son Yorum: ersinyasin
Çözüldü shell komutu hatası ancyra 0 1.949 07/09/2009, 11:56
Son Yorum: ancyra
Çözüldü kod hatası melleq 13 5.963 31/12/2008, 19:30
Son Yorum: melleq

Türkçe Çeviri: MCTR, Yazılım: MyBB, © 2002-2019 MyBB Group.