با سلام و احترام خدمت اساتید محترم
می خواستم بپرسم با چه کدی می توانم یک فایل موجود در یک پوشه را مستقیما چاپ کنم ، بدون باز کردن فایل
یعنی مستقیم فایل را برای پرینتر ارسال کنم
ممنون
با سلام و احترام خدمت اساتید محترم
می خواستم بپرسم با چه کدی می توانم یک فایل موجود در یک پوشه را مستقیما چاپ کنم ، بدون باز کردن فایل
یعنی مستقیم فایل را برای پرینتر ارسال کنم
ممنون
سلام از این لینک کمک بگیرید:نوشته شده توسط محمد رضا بهبودی
https://www.access-programmers.co.uk...folder.294370/
سلام وقت بخیر
استاد گرامی
متاسفانه نتونستم استفاده کنم .
اگر امکان داره لطفا راهنمایی بیشتری بفرمائید
ممنون
با سلام و وقت بخیر !
بصورت زیر عمل کن ببین نتیجه می گیرین:
کدهای زیر رو در یک ماژول عمومی قرار بده:
Private Declare Function apiShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) _
As Long
'***App Window Constants***
Public Const WIN_NORMAL = 1 'Open Normal
Public Const WIN_MAX = 3 'Open Maximized
Public Const WIN_MIN = 2 'Open Minimized
Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&
Public Function fPrintFile(stFile As String)
Dim lRet As Long, varTaskID As Variant
Dim stRet As String
lRet = apiShellExecute(hWndAccessApp, "print", stFile, vbNullString, vbNullString, 0&)
If lRet > ERROR_SUCCESS Then
stRet = vbNullString
lRet = -1
Else
Select Case lRet
Case ERROR_NO_ASSOC:
stRet = "Error: No associated application. Couldn't print!"
Case ERROR_OUT_OF_MEM:
stRet = "Error: Out of Memory/Resources. Couldn't print!"
Case ERROR_FILE_NOT_FOUND:
stRet = "Error: File not found. Couldn't print!"
Case ERROR_PATH_NOT_FOUND:
stRet = "Error: Path not found. Couldn't print!"
Case ERROR_BAD_FORMAT:
stRet = "Error: Bad File Format. Couldn't print!"
Case Else:
End Select
End If
fPrintFile = lRet & IIf(stRet = "", vbNullString, ", " & stRet)
End Function
Public Function PrintFiles(FolderName)
Dim NameOfFile, fsObj, FD, Fs, Fl 'Folder, Files collection, File
Dim DB As DAO.Database, FullPath As String
Set fsObj = CreateObject("Scripting.FileSystemObject")
Set FD = fsObj.GetFolder(FolderName)
Set Fs = FD.Files
Set DB = CurrentDb()
For Each Fl In Fs
NameOfFile = Fl.Name
FullPath = FolderName & "\" & NameOfFile
fPrintFile (FullPath)
Next
Set fsObj = Nothing
Set FD = Nothing
Set Fs = Nothing
End Function
بعد با این فرض که پوشه شما با نام فولد folder1 در درایو E قرار دارد از کد زیر برای چاپ فایل موجود در پوشه فوق استفاده کن :
Call PrintFiles("E:\folder1")
با سلام و احترام
استاد گرانقدر
مشکل اینجاست که در پوشه مورد نظر بیش از یک فایل وجود دارد و من فقط می خوام یکی از فایلها را پرینت بگیرم.
لطفا در صورت امکان راهنمائی بفرمائید
با سلام مجدد
برای این کار میتونید در تابع PrintFiles شرط بذارید که اگر نام فایل مساوی نام فایل مورد نظر شما بود چاپ انجام بشه:
تابع اصلاح شده زیر رو جایگزین تابع قبلی کن :
Public Function PrintFiles(FolderPath, fileName As String)
Dim fsObj, FD, Fs, Fl 'Folder, Files collection, File
Dim FullPath As String
Set fsObj = CreateObject("Scripting.FileSystemObject")
Set FD = fsObj.GetFolder(FolderPath)
Set Fs = FD.Files
For Each Fl In Fs
If Fl.Name = fileName Then
FullPath = FolderPath & "\" & Fl.Name
fPrintFile (FullPath)
End If
Next
Set fsObj = Nothing
Set FD = Nothing
Set Fs = Nothing
End Function
بعد در رویداد کلیک باتن چاپ تابع رو بصورت زیر فراخوانی کن :
Call PrintFiles("E:\folder1", "1.pdf")
بجای آرگومان اول مسیر فولدر و بجای آرگومان دوم نام فایل مورد نظر رو جایگزین کن
با سلام و احترام
استاد گرامی
از لطف و عنایت جنابعالی بسیار سپاسگزارم
ولی در زمان اجرا این خطا نمایش داده می شودUntitled.jpg
خُب این خطا داره بهت میگه که سابروتین یا فانکشن fPrintFile تعریف نشده
دلیلش هم اینه که شما فقط از فانکشن PrintFiles استفاده می کنی و فانکشن fPrintFile با بقیه کدها رو در ماژول حذف کرده ای
به کدهای پست 5 عنایت داشته باش
بنده در پست 6 عرض کردم که تابع اصلاح شده PrintFiles رو جایگزین تابع قبلی کنی نه اینکه از بقیه کدها استفاده نکنی
همه کدها:
Private Declare Function apiShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) _
As Long
'***App Window Constants***
Public Const WIN_NORMAL = 1 'Open Normal
Public Const WIN_MAX = 3 'Open Maximized
Public Const WIN_MIN = 2 'Open Minimized
Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&
Public Function fPrintFile(stFile As String)
Dim lRet As Long, varTaskID As Variant
Dim stRet As String
lRet = apiShellExecute(hWndAccessApp, "print", stFile, vbNullString, vbNullString, 0&)
If lRet > ERROR_SUCCESS Then
stRet = vbNullString
lRet = -1
Else
Select Case lRet
Case ERROR_NO_ASSOC:
stRet = "Error: No associated application. Couldn't print!"
Case ERROR_OUT_OF_MEM:
stRet = "Error: Out of Memory/Resources. Couldn't print!"
Case ERROR_FILE_NOT_FOUND:
stRet = "Error: File not found. Couldn't print!"
Case ERROR_PATH_NOT_FOUND:
stRet = "Error: Path not found. Couldn't print!"
Case ERROR_BAD_FORMAT:
stRet = "Error: Bad File Format. Couldn't print!"
Case Else:
End Select
End If
fPrintFile = lRet & IIf(stRet = "", vbNullString, ", " & stRet)
End Function
Public Function PrintFiles(FolderPath, fileName As String)
On Error GoTo Err
Dim fsObj, FD, Fs, Fl 'Folder, Files collection, File
Dim FullPath As String
Set fsObj = CreateObject("Scripting.FileSystemObject")
Set FD = fsObj.GetFolder(FolderPath)
Set Fs = FD.Files
For Each Fl In Fs
If Fl.Name = fileName Then
FullPath = FolderPath & "\" & Fl.Name
fPrintFile (FullPath)
End If
Next
Set fsObj = Nothing
Set FD = Nothing
Set Fs = Nothing
Err:
Select Case Err.Number
Case 76
MsgBox "! مسير پوشه پيدا نشد"
Case Else:
End Select
End Function
با سلام و احترام
ممنون استاد گرامی
کاملا موضوع حل شد
قوانین ایجاد تاپیک در تالار
پاسخ با نقل قول