Konu Araçları | Konu Seçenekleri | Gösterim Stili
Tarih
05/08/2018 20:03
Konu Sahibi
fascioğlu
Yorumlar
7
Okunma
498
Konuyu Oyla:
  • Derecelendirme: 0/5 - 0 oy
  • 5
  • 4
  • 3
  • 2
  • 1

Derecelendirme: 0/5 - 0 oy
fascioğlu

fascioğlu

Aktif Üye*
24774
Fa.... Aş....
 64
 203
 1.016
 18/09/2010
170
 Muğla
 Emekli_Turizm
 Ofis 2003
 30/01/2019,00:37
Çözüldü 
Sayın Hocalarım,

Liste kutusu oluşturduğumuzda ,
1-Sayıları sağa yaslama,
2-Para birimlerini biçimlendirme,
olayını nasıl oluşturabiliriz,her hangi bir yöntemi varmı.
Saygılarımla.



ozanakkaya

ozanakkaya

Kurucu
1
Oz.... Ak....
 39
 483
 12.100
 29/01/2008
 Denizli
 Memur
 Ofis 2010 32 Bit
 Bugün,20:08
Merhaba, liste kutusundaki veride sağa veya sola yaslama özelliği modül ile yapılabiliyor.  

Visual Basic Code
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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
Option Compare Database
Option Explicit

'Authors:      Stephen Lebans
'              Terry Kreft
'Date:         Dec 14, 1999
'Copyright:    Lebans Holdings (1999) Ltd.
'              Terry Kreft
'Use:          Center and Right Align data in
'              List or Combo control's
'Bugs:         Please me know if you find any.
'Contact:      Stephen@lebans.com


Private Type Size
        cx As Long
        cy As Long
End Type

Private Const LF_FACESIZE = 32

Private Type LOGFONT
        lfHeight As Long
        lfWidth As Long
        lfEscapement As Long
        lfOrientation As Long
        lfWeight As Long
        lfItalic As Byte
        lfUnderline As Byte
        lfStrikeOut As Byte
        lfCharSet As Byte
        lfOutPrecision As Byte
        lfClipPrecision As Byte
        lfQuality As Byte
        lfPitchAndFamily As Byte
        lfFaceName As String * LF_FACESIZE
End Type

Private Declare Function apiCreateFontIndirect Lib "gdi32" Alias _
        "CreateFontIndirectA" (lplogfont As LOGFONT) As Long

Private Declare Function apiSelectObject Lib "gdi32" _
 Alias "SelectObject" (ByVal hDC As Long, ByVal hObject As Long) As Long

Private Declare Function apiGetDC Lib "user32" _
  Alias "GetDC" (ByVal hWnd As Long) As Long

Private Declare Function apiReleaseDC Lib "user32" _
  Alias "ReleaseDC" (ByVal hWnd As Long, _
  ByVal hDC As Long) As Long

Private Declare Function apiDeleteObject Lib "gdi32" _
  Alias "DeleteObject" (ByVal hObject As Long) As Long

Private Declare Function apiGetTextExtentPoint32 Lib "gdi32" _
Alias "GetTextExtentPoint32A" _
(ByVal hDC As Long, ByVal lpsz As String, ByVal cbString As Long, _
lpSize As Size) As Long

 ' Create an Information Context
 Declare Function apiCreateIC Lib "gdi32" Alias "CreateICA" _
  (ByVal lpDriverName As String, ByVal lpDeviceName As String, _
  ByVal lpOutput As String, lpInitData As Any) As Long
  
 ' Close an existing Device Context (or information context)
 Declare Function apiDeleteDC Lib "gdi32" Alias "DeleteDC" _
  (ByVal hDC As Long) As Long

 Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
 
 Private Declare Function GetDeviceCaps Lib "gdi32" _
 (ByVal hDC As Long, ByVal nIndex As Long) As Long
 
 ' Constants
 Private Const SM_CXVSCROLL = 2
 Private Const LOGPIXELSX = 88
 
 
 
'­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­ 
' 1) We now call the function with an Optional SubForm parameter. This is
' the name of the SubForm Control. If you used the Wizard to add the
' SubForm to the main Form then the SubForm control has the same name as
' the SubForm. But this is not always the case. For the benefit of those
' lurkers out there<bg> we must remember that the SubForm and the SubForm
' Control are two seperate entities. It's very straightforward, the
' SubForm Control houses the actual SubForm. Sometimes the have the same
' name, very confusing, or you can name the Control anything you want! In
' this case for clarity I changed the name of the SubForm Control to
' SFFrmJustify. Ugh..OK that's not too clear but it's late!
' 
' So the adjusted SQL statement is now.
' CODENUM: JustifyString("FrmMain","List5",[code],0,True,"SFfrmJustify")
'­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­­ 



' ***CODE START
Function JustifyString(myform As String, myctl As String, myfield As Variant, _
 col As Integer, RightOrCenter As Integer, Optional Sform As String = "") As Variant

 ' March 21, 2000
 ' Changes RightOrCenter to Integer from Boolean
 ' -1 = Right. 0 = Center, 1 = Left

 ' Called from UserDefined Function in Query like:
 ' SELECT DISTINCTROW JustifyString("frmJustify","list4",_
 ' [code],0,False) AS CODENUM, HORTACRAFT.NAME FROM HORTACRAFT;

 ' myform = name of form containing control
 ' myctl = name of control
 ' myfield is the actual data field from query we will Justify
 ' col = column of the control the data is to appear in(0 based index)
 ' RightOrCenter True = Right. False = Center

 Dim UserControl As Control
 Dim UserForm As Form
 Dim lngWidth As Long

 Dim intSize As Integer
 Dim strText As String
 Dim lngL As Long
 Dim strColumnWidths As String
 Dim lngColumnWidth As Long
 Dim lngScrollBarWidth As Long
 Dim lngOneSpace As Long
 Dim lngFudge As Long
 Dim arrCols() As String
 Dim lngRet As Long

 ' Add your own Error Handling
 On Error Resume Next

 ' Need fudge factor.
 ' Access allows for a margin in drawing its Controls.
 lngFudge = 60

 ' We need the Control as an Object
 ' Check and see if use passed SubForm or not
If Len(Sform & vbNullString) > 0 Then
    Set UserForm = Forms(myform).Controls(Sform).Form
Else
    Set UserForm = Forms(myform)
End If

 ' Assign ListBox or Combo to our Control var
 Set UserControl = UserForm.Controls.Item(myctl)

 With UserControl
   If col > Split(arrCols(), .ColumnWidths, ";") Then Exit Function
   If col = .ColumnCount - 1 Then
     ' Add in the width of the scrollbar, which we get in pixels.
     ' Convert it to twips for use in Access.
     lngScrollBarWidth = GetSystemMetrics(SM_CXVSCROLL)
     lngScrollBarWidth = lngScrollBarWidth * (1440 / GetTwipsPerPixel())
   End If
   lngColumnWidth = Nz(Val(arrCols(col)), 1)
   lngColumnWidth = lngColumnWidth - (lngScrollBarWidth + lngFudge)
 End With

 ' Single space character will be used
 ' to calculate the number of SPACE characters
 ' we have to add to the Input String to
 ' achieve Right justification.
 strText = " "

 ' Call Function to determine how many
 ' Twips in width our String is
 lngWidth = StringToTwips(UserControl, strText)

 ' Check for error
 If lngWidth > 0 Then
       lngOneSpace = Nz(lngWidth, 0)
    
     ' Clear variables for next call
       lngWidth = 0
    
     ' Convert all variables to type string
     Select Case VarType(myfield)
    
     Case 1 To 6, 7
     ' It's a number(1-6) or 7=date
     strText = Str$(myfield)
    
     Case 8
     ' It's a string..leave alone
     strText = myfield
    
     Case Else
     ' Houston, we have a problem
        Call MsgBox("Field type must be Numeric, Date or String", vbOKOnly)
    
     End Select
    
     'let's trim the string - better safe than sorry :-)
     strText = Trim$(strText)
    
     ' Call Function to determine how many
     ' Twips in width our String is
     lngWidth = StringToTwips(UserControl, strText)
    
     ' Check for error
     If lngWidth > 0 Then
    
        ' Calculate how many SPACE characters to append
        ' to our String.
        ' Are we asking for Right or Center Alignment?
         Select Case RightOrCenter
            Case -1
            ' Right
            strText = String(Int((lngColumnWidth - lngWidth) / lngOneSpace), " ") & strText
           
            Case 0
            ' Center
            strText = String((Int((lngColumnWidth - lngWidth) / lngOneSpace) / 2), " ") & strText _
               & String((Int((lngColumnWidth - lngWidth) / lngOneSpace) / 2), " ")
           
             Case 1
            ' Left
            strText = strText
           
             Case Else
        End Select
           ' Return Original String with embedded Space characters
          JustifyString = strText
    End If
 End If
 
 ' Cleanup
 Set UserControl = Nothing
 Set UserForm = Nothing
 
 End Function



 Function Split(ArrayReturn() As String, ByVal StringToSplit As String, _
 SplitAt As String) As Integer
   Dim intInstr As Integer
   Dim intCount As Integer
   Dim strTemp As String

   intCount = -1
   intInstr = InStr(StringToSplit, SplitAt)
   Do While intInstr > 0
     intCount = intCount + 1
     ReDim Preserve ArrayReturn(0 To intCount)
     ArrayReturn(intCount) = Left(StringToSplit, intInstr - 1)
     StringToSplit = Mid(StringToSplit, intInstr + 1)
     intInstr = InStr(StringToSplit, SplitAt)
   Loop
   If Len(StringToSplit) > 0 Then
     intCount = intCount + 1
     ReDim Preserve ArrayReturn(0 To intCount)
     ArrayReturn(intCount) = StringToSplit
   End If
   Split = intCount
 End Function
 '*************  Code End   *************


Private Function StringToTwips(ctl As Control, strText As String) As Long
    Dim myfont As LOGFONT
    Dim stfSize As Size
    Dim lngLength As Long
    Dim lngRet As Long
    Dim hDC As Long
    Dim lngscreenXdpi As Long
    Dim fontsize As Long
    Dim hfont As Long, prevhfont As Long
    
    ' Get Desktop's Device Context
    hDC = apiGetDC(0&)
    
    'Get Current Screen Twips per Pixel
    lngscreenXdpi = GetTwipsPerPixel()
    
    ' Build our LogFont structure.
    ' This  is required to create a font matching
    ' the font selected into the Control we are passed
    ' to the main function.
    'Copy font stuff from Text Control's property sheet
    With myfont
        .lfFaceName = ctl.FontName & Chr$(0)  'Terminate with Null
        fontsize = ctl.fontsize
        .lfWeight = ctl.FontWeight
        .lfItalic = ctl.FontItalic
        .lfUnderline = ctl.FontUnderline
    
        ' Must be a negative figure for height or system will return
        ' closest match on character cell not glyph
        .lfHeight = (fontsize / 72) * -lngscreenXdpi
    End With
                                     
    ' Create our Font
    hfont = apiCreateFontIndirect(myfont)
    ' Select our Font into the Device Context
    prevhfont = apiSelectObject(hDC, hfont)
                
    ' Let's get length and height of output string
    lngLength = Len(strText)
    lngRet = apiGetTextExtentPoint32(hDC, strText, lngLength, stfSize)
    
    ' Select original Font back into DC
    hfont = apiSelectObject(hDC, prevhfont)
    
    ' Delete Font we created
    lngRet = apiDeleteObject(hfont)
        
    ' Release the DC
    lngRet = apiReleaseDC(0&, hDC)
        
    ' Return the length of the String in Twips
    StringToTwips = stfSize.cx * (1440 / GetTwipsPerPixel())
        
End Function


Private Function GetTwipsPerPixel() As Integer

    ' Determine how many Twips make up 1 Pixel
    ' based on current screen resolution
    
    Dim lngIC As Long
    lngIC = apiCreateIC("DISPLAY", vbNullString, _
     vbNullString, vbNullString)
    
    ' If the call to CreateIC didn't fail, then get the info.
    If lngIC <> 0 Then
        GetTwipsPerPixel = GetDeviceCaps(lngIC, LOGPIXELSX)
        ' Release the information context.
        apiDeleteDC lngIC
    Else
        ' Something has gone wrong. Assume a standard value.
        GetTwipsPerPixel = 120
    End If
 End Function


Üstteki kodu modüle kaydedip liste kutusunun satır kaynağındaki sorguda, sağa yaslanacak alana 

SQL Code
JustifyString("formadi";"listekutusuadi";[alanadi];0;Doğru)


Şeklinde kod eklerseniz liste kutusundaki bu alan sağa yaslanır. 

Para birimi için liste kutusunun satır kaynağındaki sorguya format işlevi eklenebilir. 
format("[paraalani]";"currency")


"Boş Örnek Eklerim, Yapıp Verirler" demeyin, örneğinizi hazırlayın.
Komplike kod talebiniz var ise İletişim bağlantısından bize ulaşın. 
Cebelleşmezsen Öğrenemezsin. 

...........
fascioğlu

fascioğlu

Aktif Üye*
24774
Fa.... Aş....
 64
 203
 1.016
 18/09/2010
170
 Muğla
 Emekli_Turizm
 Ofis 2003
 30/01/2019,00:37
Sayın Ozan Hocam,
Verdiğiniz kodu module kaydettim

Liste kutusunun Satır kaynağındaki sorgu

SQL Code
SELECT tbl_Urun_Giris.URUNID, tbl_Urun_Giris.ISLEMNO, tbl_Urun_Giris.KATEGORI, tbl_Urun_Giris.URUNADI, tbl_Urun_Giris.URUNCINSI, tbl_Urun_Giris.URUNMIKTARI, tbl_Urun_Giris.URUNBIRIMI, tbl_Urun_Giris.GIRISFIYATI, tbl_Urun_Giris.SATISFIYATI, tbl_Urun_Giris.SONKULLANMATARIHI
FROM tbl_Urun_Giris;


ise bu,
örnek verdiğiniz sağa yaslama kodu ile para birimi formatını Sql kodunun neresine eklemeliyim.
Birçok denememe rağmen sonuç olumsuz.

Saygılarımla.



fascioğlu

fascioğlu

Aktif Üye*
24774
Fa.... Aş....
 64
 203
 1.016
 18/09/2010
170
 Muğla
 Emekli_Turizm
 Ofis 2003
 30/01/2019,00:37
Sayın Ozan hocam,

Herhangi bir kod kullanmadan,Parabirimini uyguladım,
Şöyleki,tablo tasarımda parabirimi alanlarının giriş maskesine "#.##0,00 ₺;-#.##0,00 ₺" formatını uyguladım ve para birimi liste kutusuna  geldi,ama farklı olarak tl simgesi rakamın arkasında değilde önüne geldi.

Saygılarımla,bilginize.



...........
ozanakkaya

ozanakkaya

Kurucu
1
Oz.... Ak....
 39
 483
 12.100
 29/01/2008
 Denizli
 Memur
 Ofis 2010 32 Bit
 Bugün,20:08
Sorgu koduna ekleme yapamazsın. Kodu kopyala, yeni sorgu oluşturup Sql kaynağına bu kodu yapıştır. Sorguyu tasarım görünümünde açıp sağa yaslanacak alanda üstteki Kod form ve alan isimlerine göre değiştir. Para birimi için de aynı işlemi uygula.


"Boş Örnek Eklerim, Yapıp Verirler" demeyin, örneğinizi hazırlayın.
Komplike kod talebiniz var ise İletişim bağlantısından bize ulaşın. 
Cebelleşmezsen Öğrenemezsin. 

fascioğlu

fascioğlu

Aktif Üye*
24774
Fa.... Aş....
 64
 203
 1.016
 18/09/2010
170
 Muğla
 Emekli_Turizm
 Ofis 2003
 30/01/2019,00:37
Sayın hocam,
Bir örnekle açaıklama yapabilirmisiniz.



...........

Konuyu Okuyanlar: 1 Ziyaretçi

Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
Çözüldü Her Yeni Kayıta Bastığımızda Sayı Verme Sorunu. prestij06 7 144 15/06/2019, 21:24
Son Yorum: halily
Çözüldü İki Liste Kutusundan Aynı Tablo Üzerinde Güncelleme Yapmak Yunus Bozkurt 14 416 10/06/2019, 16:31
Son Yorum: Yunus Bozkurt
Çözüldü Raporda Sayfa Alt Bilgisi Liste Boyuna Göre Yapışık Olsun Yardım okumas 2 111 30/05/2019, 15:38
Son Yorum: okumas
Çözüldü Access'te Otomatik Sayı Kontrolü dgnlrmehmet 3 176 26/04/2019, 12:17
Son Yorum: dgnlrmehmet
Çözüldü Aynı Tabloda İkitane Otomatik Sayı Alanı Verme respectful 13 725 22/04/2019, 23:36
Son Yorum: halily

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