• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Tam ekran olmayan ListBox lar

E

Ergün GÖKER

Katılım
25 Ağustos 2012
Mesajlar
562
Excel Vers. ve Dili
Office 2003
Değerli hocalarım herkese kolay gelsin.
Bir çalışmamda userformları tam ekran yapıyorum aşağıdaki kodları uyguluyorum. Userformlar tam ekran oluyor fakat form üzerinde bulunan tüm nesnelerinde tam ekran olmasını istiyorum. fakat ListBox ve içindeki metinler tam ekran modunda büyümüyor. Forumda aramam rağmen bulamadım. yardımlarınızı bekliyorum.

Private Sub UserForm_Initialize()
With Application
Me.Top = .Top
Me.Left = .Left
Me.Height = .Height
Me.Width = .Width
End With
End Sub


Private Sub UserForm_Initialize() ' TAM EKRAN USER FORM
Dim X1 As Long, Y1 As Long, Y2 As Long, X2 As Long
Dim CX As Double, CY As Double
Dim MyCtrl As Control
X1 = Application.Width
Y1 = Application.Height
X2 = Me.Width
Y2 = Me.Height
CX = X1 / X2
CY = Y1 / Y2
Me.Width = X1
Me.Height = Y1
For Each MyCtrl In Me.Controls
MyCtrl.Top = MyCtrl.Top * CY
MyCtrl.Left = MyCtrl.Left * CX
MyCtrl.Width = MyCtrl.Width * CX
MyCtrl.Height = MyCtrl.Height * CY
On Error Resume Next
MyCtrl.Font.Size = MyCtrl.Font.Size * CY
On Error GoTo 0
Next

End Sub
 
Formda birçok eklediğim dosyalarda mevcut kodlar örnek dosya ekliyorum


Kod: 
'Option Explicit
Private gen As Single
Private yuk As Single
Dim kolon1(5000)
Dim kolon2(5000)
Dim kolon3(5000)
Dim kolon4(5000)
Dim kolon5(5000)
Dim kolon6(5000)
Dim kolon7(5000)

Private Sub UserForm_Initialize()


[COLOR="Red"]'""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

'AÇILIŞ KODLARI VARSA BURAYA YAZILACAK

'""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
[/COLOR]
Dim i As Integer, j As Integer, r As Integer
i = 0

Dim Kontrol As Control
For Each Kontrol In Me.Controls
i = i + 1
kolon1(i) = Kontrol.Height
kolon2(i) = Kontrol.Width
kolon3(i) = Kontrol.Top
kolon4(i) = Kontrol.Left

If TypeName(Kontrol) = "ListBox" Then
If Controls(Kontrol.Name).ColumnCount > 0 Then
For j = 1 To Controls(Kontrol.Name).ColumnCount
kolon6(j) = Sheets(ActiveSheet.Name).Columns(j).Width
Next
End If
End If

If TypeName(Kontrol) = "ListView" Then
If Controls(Kontrol.Name).ColumnHeaders.Count > 0 Then
For r = 1 To Controls(Kontrol.Name).ColumnHeaders.Count
kolon7(r) = Controls(Kontrol.Name).ColumnHeaders(r).Width
Next
End If
End If

If TypeName(Kontrol) = "ListBox" Or _
TypeName(Kontrol) = "ListView" Or _
TypeName(Kontrol) = "ComboBox" Or _
TypeName(Kontrol) = "Label" Or _
TypeName(Kontrol) = "TextBox" Or _
TypeName(Kontrol) = "CommandButton" Or _
TypeName(Kontrol) = "OptionButton" Or _
TypeName(Kontrol) = "CheckBox" Then
kolon5(i) = Val(Controls(Kontrol.Name).Font.Size)
End If
Next

gen = Me.Width
yuk = Me.Height

Dim objWshShell

Set objWshShell = CreateObject("WScript.shell")
objWshShell.popup "testing", 1, "no button, no icon", 8
Set objWshShell = Nothing

With Application
Me.Top = .Top
Me.Left = .Left
Me.Height = .Height
Me.Width = .Width
End With

End Sub

Private Sub UserForm_Resize()
Dim i As Integer, j As Integer, r As Integer
Dim genis As Single
Dim yuksek As Single
Dim yer, deg

i = 0
genis = Me.Width / gen
yuksek = Me.Height / yuk
'On Error Resume Next
Dim Kontrol As Control
For Each Kontrol In Me.Controls
i = i + 1
Kontrol.Height = yuksek * kolon1(i)
Kontrol.Width = genis * kolon2(i)
Kontrol.Top = yuksek * kolon3(i)
Kontrol.Left = genis * kolon4(i)

If TypeName(Kontrol) = "ListBox" Then
If Controls(Kontrol.Name).ColumnCount > 0 Then
For j = 1 To Controls(Kontrol.Name).ColumnCount
yer = genis * kolon6(j)
deg = deg & CLng(yer) & ";"
Next
Controls(Kontrol.Name).ColumnWidths = deg
End If
End If

If TypeName(Kontrol) = "ListView" Then
If Controls(Kontrol.Name).ColumnHeaders.Count > 0 Then
For r = 1 To Controls(Kontrol.Name).ColumnHeaders.Count
Controls(Kontrol.Name).ColumnHeaders(r).Width = genis * kolon7(r)
Next
End If
End If

If TypeName(Kontrol) = "ListBox" Or _
TypeName(Kontrol) = "ListView" Or _
TypeName(Kontrol) = "ComboBox" Or _
TypeName(Kontrol) = "Label" Or _
TypeName(Kontrol) = "TextBox" Or _
TypeName(Kontrol) = "CommandButton" Or _
TypeName(Kontrol) = "OptionButton" Or _
TypeName(Kontrol) = "CheckBox" Then
Kontrol.Font.Size = yuksek * kolon5(i)

If Kontrol.Font.Size >= 10 Then
Kontrol.Font.Size = 10
End If
End If

Next
End Sub
 

Ekli dosyalar

Halit hocam öncelikle cevap verdiğiniz için teşekkür ederim.
Verdiğiniz kodu tam olarak anlayamadım. Örnek dosyaya baktığımda tam ekran olarak nasıl veya hangi kodla yapacağım yardımcı olursanız sevinirim
Benim formum açılır açılmaz tam ekran olarak açılıyor.
 
Son düzenleme:
Bir userform için Buraya eklediğim kodların hepsini kullanacaksınız.
örnek dosyada fazladan
Kod: 
CommandButton1_Click
CommandButton2_Click

bunlar var
 
Hocam Merhaba

halit3' Alıntı:
Bir userform için Buraya eklediğim kodların hepsini kullanacaksınız.
örnek dosyada fazladan
Kod: 
CommandButton1_Click
CommandButton2_Click

bunlar var
Genişletmek için tıkla ...

halit Hocam saygılar
Hocam dosyayı ben düzeltemedim
dosyamı epostanıza atsam bakma şansınız varmıdır
 
Son düzenleme:
kod:

Kod: 
Private Sub UserForm_Initialize()

Set objWshShell = CreateObject("WScript.shell")
objWshShell.popup "testing", 1, "no button, no icon", 8
Set objWshShell = Nothing

With Application
Me.Top = .Top
Me.Left = .Left
Me.Height = .Height
Me.Width = .Width
End With

End Sub

Private Sub UserForm_Resize()
k = 0
j = 0
deg = ""
deg2 = 0
mert = 1
Dim X1 As Long, Y1 As Long, Y2 As Long, X2 As Long
Dim CX As Double, CY As Double
Dim MyCtrl As Control
X1 = Application.Width
Y1 = Application.Height
X2 = Me.Width
Y2 = Me.Height
CX = X1 / X2
CY = Y1 / Y2
Me.Width = X1
Me.Height = Y1
For Each MyCtrl In Me.Controls
MyCtrl.Top = MyCtrl.Top * CY
MyCtrl.Left = MyCtrl.Left * CX
MyCtrl.Width = MyCtrl.Width * CX
MyCtrl.Height = MyCtrl.Height * CY

If TypeName(MyCtrl) = "ListBox" Then
For j = 1 To Controls(MyCtrl.Name).ColumnCount
k = k + 1
yer = CX * Sheets(ActiveSheet.Name).Columns(k).Width
deg = deg & CLng(yer) & ";"
deg2 = deg2 + CLng(yer)
Next
Controls(MyCtrl.Name).ColumnWidths = deg
'Controls(MyCtrl.Name).Height = MyCtrl.Height * CX
End If


If TypeName(MyCtrl) = "ListView" Then
For j = 1 To Controls(MyCtrl.Name).ColumnHeaders.Count
Controls(MyCtrl.Name).ColumnHeaders(j).Width = CX * Sheets(ActiveSheet.Name).Columns(j).Width
Next
Controls(MyCtrl.Name).Height = MyCtrl.Height * CX

End If

On Error Resume Next
MyCtrl.Font.Size = MyCtrl.Font.Size * CY
On Error GoTo 0
Next

End Sub
 
Hocam deneyip dönüş yapacağım. Teşekkürler
Saygılarımla
Hocam Çok uğraştım diğer userformlarda İstediğimi yapıyor. Fakat bir userformumda maalesef olmuyor.
 
birde bunu dene


Kod: 
'Option Explicit
Private gen As Single
Private yuk As Single
Dim kolon1(5000)
Dim kolon2(5000)
Dim kolon3(5000)
Dim kolon4(5000)
Dim kolon5(5000)
Dim kolon6(5000)
Dim kolon7(5000)

Private Sub UserForm_Initialize()


[COLOR="Red"]'""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

'AÇILIŞ KODLARI VARSA BURAYA YAZILACAK

'""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""[/COLOR]

Dim i As Integer, j As Integer, r As Integer
i = 0

Dim Kontrol As Control
For Each Kontrol In Me.Controls
i = i + 1
kolon1(i) = Kontrol.Height
kolon2(i) = Kontrol.Width
kolon3(i) = Kontrol.Top
kolon4(i) = Kontrol.Left

If TypeName(Kontrol) = "ListBox" Then
If Controls(Kontrol.Name).ColumnCount > 0 Then
For j = 1 To Controls(Kontrol.Name).ColumnCount
kolon6(j) = Sheets(ActiveSheet.Name).Columns(j).Width
Next
End If
End If

If TypeName(Kontrol) = "ListView" Then
If Controls(Kontrol.Name).ColumnHeaders.Count > 0 Then
For r = 1 To Controls(Kontrol.Name).ColumnHeaders.Count
kolon7(r) = Controls(Kontrol.Name).ColumnHeaders(r).Width
Next
End If
End If

If TypeName(Kontrol) = "ListBox" Or _
TypeName(Kontrol) = "ListView" Or _
TypeName(Kontrol) = "ComboBox" Or _
TypeName(Kontrol) = "Label" Or _
TypeName(Kontrol) = "TextBox" Or _
TypeName(Kontrol) = "CommandButton" Or _
TypeName(Kontrol) = "OptionButton" Or _
TypeName(Kontrol) = "CheckBox" Then
kolon5(i) = Val(Controls(Kontrol.Name).Font.Size)
End If
Next

gen = Me.Width
yuk = Me.Height

Dim objWshShell

Set objWshShell = CreateObject("WScript.shell")
objWshShell.popup "testing", 1, "no button, no icon", 8
Set objWshShell = Nothing

With Application
Me.Top = .Top
Me.Left = .Left
Me.Height = .Height
Me.Width = .Width
End With

End Sub

Private Sub UserForm_Resize()
Dim i As Integer, j As Integer, r As Integer
Dim genis As Single
Dim yuksek As Single
Dim yer, deg

i = 0
genis = Me.Width / gen
yuksek = Me.Height / yuk
'On Error Resume Next
Dim Kontrol As Control
For Each Kontrol In Me.Controls
i = i + 1
Kontrol.Height = yuksek * kolon1(i)
Kontrol.Width = genis * kolon2(i)
Kontrol.Top = yuksek * kolon3(i)
Kontrol.Left = genis * kolon4(i)

If TypeName(Kontrol) = "ListBox" Then
If Controls(Kontrol.Name).ColumnCount > 0 Then
For j = 1 To Controls(Kontrol.Name).ColumnCount
yer = genis * kolon6(j)
deg = deg & CLng(yer) & ";"
Next
Controls(Kontrol.Name).ColumnWidths = deg
End If
End If

If TypeName(Kontrol) = "ListView" Then
If Controls(Kontrol.Name).ColumnHeaders.Count > 0 Then
For r = 1 To Controls(Kontrol.Name).ColumnHeaders.Count
Controls(Kontrol.Name).ColumnHeaders(r).Width = genis * kolon7(r)
Next
End If
End If

If TypeName(Kontrol) = "ListBox" Or _
TypeName(Kontrol) = "ListView" Or _
TypeName(Kontrol) = "ComboBox" Or _
TypeName(Kontrol) = "Label" Or _
TypeName(Kontrol) = "TextBox" Or _
TypeName(Kontrol) = "CommandButton" Or _
TypeName(Kontrol) = "OptionButton" Or _
TypeName(Kontrol) = "CheckBox" Then
Kontrol.Font.Size = yuksek * kolon5(i)

If Kontrol.Font.Size >= 10 Then
Kontrol.Font.Size = 10
End If
End If

Next
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst