Açık Excel Kitaplarını Yerleştirme

Açık Excel Kitaplarını Yerleştirme

Açık Excel Kitaplarını Yerleştirme isimli içerikte, ilgili işlemin VBA kodları ile nasıl yapacağınızı öğreten bir Hazır Makro Kodu yer almaktadır.

Hazır Kod​

VBA:
Sub test_windows()
    ActiveWindow.WindowState = xlNormal
 
    Tiler Windows, 0, 0, Application.UsableWidth, Application.UsableHeight, , 2
End Sub
Sub Tiler(ObjColl As Object, OffsetX As Double, OffsetY As Double, _
    UsableWidth As Double, UsableHeight As Double, _
    Optional Rows As Long = 0, Optional Cols As Long = 0)
    Dim i As Long, blnByCols As Boolean
    Dim lngPri As Long, lngSec As Long, lngPriRemainder As Long
    Dim dblPriMax As Double, dblSecMax As Double
    Dim dblPriStart As Double, dblSecStart As Double
    Dim dblPriLen As Double, dblSecLen As Double
 
    If Cols = 0 And Rows = 0 Then Exit Sub
 
    blnByCols = Not Cols = 0
 
    lngPri = IIf(blnByCols, Cols, Rows)
    dblPriMax = IIf(blnByCols, UsableWidth, UsableHeight)
    dblSecMax = IIf(blnByCols, UsableHeight, UsableWidth)
    lngPriRemainder = ObjColl.Count Mod lngPri
    lngSec = -Int(-ObjColl.Count / lngPri)
    dblSecLen = dblSecMax / lngSec
 
    For i = 0 To ObjColl.Count - 1
  If i >= ObjColl.Count - lngPriRemainder Then
dblPriStart = dblPriMax / lngPriRemainder * ((i Mod lngPri) Mod lngPriRemainder)
dblPriLen = dblPriMax / lngPriRemainder
  Else
dblPriStart = dblPriMax / lngPri * (i Mod lngPri)
dblPriLen = dblPriMax / lngPri
  End If
  dblSecStart = (dblSecMax / lngSec) * Int(i / lngPri)
 
  ObjColl(i + 1).Left = IIf(blnByCols, dblPriStart, dblSecStart) + OffsetX
  ObjColl(i + 1).Top = IIf(blnByCols, dblSecStart, dblPriStart) + OffsetY
  ObjColl(i + 1).Width = IIf(blnByCols, dblPriLen, dblSecLen)
  ObjColl(i + 1).Height = IIf(blnByCols, dblSecLen, dblPriLen)
    Next
End Sub

Açıklama​

Tüm açık Excel dosyalarınız tek bir pencerede listelenir.

Faydalanılması temennisiyle
 
Benzer Konular Popüler İçerikler Daha Fazlası
Geri
Üst