Sn.Alpeki99
İki nedenle henüz cevap veremedim
vb kodlarına çok hakim olamadığım ve sizlere göre çok amatörce ve kendi programıma entegre etmekte uzun zaman harcadığım için henüz işe yararlılığı konusunda tam bir fikrim olmadan,
2010 accessi henüz edinemediğim için resimdene.rar konusunda çalışma yapamadığımdan
sizlerin değerli vaktini boşa harcamamak adına sizin yardım amacıyla gönderdiğiniz programların incelemesini yapmadan yazmak istemedim.
Ayrıca açmış olduğum konunun sizler tarafından takip edilmesi benim için gerçekten çok değerli,
teşekkür ederim
2. mesaja eklediğim örnek ofis 2000 formatında.
2.örnekteki formun vb kodlarını inceledim,sanırım bu çok işime yarayacak,programıma entegre edebilmem için tek tıkla ,(mesela ;imajedit formundaki load butonuyla) resmi seçip save tuışunu kullanmadan resimler klasörüne bmp formatında göndermesini sağlamaya çalışacağım.
bunu becerebilmemin biraz uzun süreceğini düşünüyorum.Kolay bir yolu varsa benimle paylaşırmısınız.
teşekkürler
herkese teşekkürler
sonunda başardım,
resim eklemek istediğim yere jpg yada başka uzantılı olan resimleri resmi seçipaç butonuna tıkladığım zaman bmp formatında ve değişken müşteri sayfasına protokol no ile ekleyebiliyorum.
benim için önemli bir problemdi,tekrar tekrar teşekkürler
Sn.Vetaltan,
Basardiginiza sevindim. Ancak bunu Forumda paylasirmisiniz. Ihtiyaci olan arkadaslar da faydalansinlar bu basarinizdan.
Selamlar
resim üzerine çift tıklayarak müşteri resmi yoksa;müşteri numarasıyla ,hangi formatta olursa olsun seçtiğiniz resmi daha önceden tanımladığınız klasöre bmp formatında kopyalıyor.eğer müşteri resmi varsa irfan view kullanarak resmi açıyor.
sn.Alpekinin paylaşmış olduğu Resim_Formatini_Degistir.rar kodlarını ihtiyacım olan şekilde değiştirerek programıma uyguladım sorunsuz çalışıyor.Kendisine teşekkür ederim.
Kodları aşağıda yazdım:
-------------------------------------
Option Compare Database
Option Explicit
Private Const Irfan1 As String = "C:\Program Files\IrfanView\i_view32.exe"
Dim ctlCurrentControl As Control, strControlName As String
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal _
dwAccess As Long, ByVal fInherit As Integer, ByVal hObject _
As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal _
hObject As Long) As Long
----------------------
-----------------------
Private Sub RESIM_DblClick(Cancel As Integer)
Dim ekocan As String
Dim altan As String
Dim bute As String
Dim r
altan = StrReverse(CurrentDb.Name)
bute = Trim(Mid(altan, 13))
Dim Temppic1 As String
Dim strFilter As String, strInputFileName As String, path1, fso, stAppName As String, newfilename1 As String
Temppic1 = StrReverse(bute) & "resim\1a.jpg"
If RESIM.Picture = StrReverse(bute) & "resim\ARKAPLAN\LOGOB.BMP" Then
r = MsgBox("Müşteri Resmi Kayıtlarımızda Bulunmamaktadır" & Chr(13) & "Eklemek İstermisiniz!", 32 + vbYesNo)
If r = vbYes Then
Set fso = CreateObject("WScript.Shell")
path1 = fso.SpecialFolders("MyDocuments")
strFilter = ahtAddFilterItem(strFilter, "Resim Dosyaları (*.*)", "*.JPG;*.GIF;*.BMP;*.PNG;*.TIF;*.RAW;*.ICO;*.PCX;*.PBM;*.DCM")
strInputFileName = ahtCommonFileOpenSave( _
InitialDir:=path1, Filter:=strFilter, OpenFile:=True, _
DialogTitle:=" Resim Seçiniz", _
Flags:=ahtOFN_HIDEREADONLY)
Me.OriginalPic1 = strInputFileName
FileCopy strInputFileName, Temppic1
Me.RESIM.Picture = Temppic1
Set fso = CreateObject("WScript.Shell")
path1 = fso.SpecialFolders("MyDocuments")
strFilter = ahtAddFilterItem(strFilter, "Image Files (*.*)", "*.*")
strInputFileName = protokol.Value & ".BMP"
stAppName = Irfan1 & " " & Temppic1
If Me.FileTypeCombo = "JPG" Then
If UCase(Right(strInputFileName, 4)) <> ".JPG" Then strInputFileName = strInputFileName & ".JPG"
stAppName = stAppName & " /jpgq=" & Me.Compression0 & " /convert=" & strInputFileName
Else
If UCase(Right(strInputFileName, 4)) <> UCase("." & Me.FileTypeCombo) Then strInputFileName = strInputFileName & "." & Me.FileTypeCombo
stAppName = stAppName & " /convert=" & strInputFileName
End If
LaunchApp32 (stAppName)
End If
Else
ekocan = "C:\Program Files\IrfanView\i_view32.exe " & StrReverse(bute) & "resim\" & Form_musteri.protokol.Value & ".BMP"
Call Shell(ekocan, 1)
Exit Sub
End If
End Sub
---------------------
Function LaunchApp32(MYAppname As String) As Integer
Const SYNCHRONIZE = 1048576
Const INFINITE = -1&
Dim ProcessID&
Dim ProcessHandle&
Dim Ret&
LaunchApp32 = -1
ProcessID = Shell(MYAppname, vbNormalFocus)
If ProcessID <> 0 Then
ProcessHandle = OpenProcess(SYNCHRONIZE, True, ProcessID&)
Ret = WaitForSingleObject(ProcessHandle, INFINITE)
Ret = CloseHandle(ProcessHandle)
Else
MsgBox "ERROR : Unable to start " & MYAppname
LaunchApp32 = 0
End If
End Function
-----------------
umarım ihtiyacı olan arkadaşların işine yarar
hepinize kolay gelsin arkadaşlar.