📜  标签自动 - 无论代码示例

📅  最后修改于: 2022-03-11 14:56:31.905000             🧑  作者: Mango

代码示例1
Private Sub UserForm_Initialize()
 
    Dim Fe As Worksheet
    Dim I As Long
    Dim J As Long
    Dim DerLg As Long
    Dim DerCol As Long
    Dim Haut As Long
    Dim Gauche As Long
    Dim Largeur As Integer
    Dim Hauteur As Integer
 
    Set Fe = Worksheets("Feuil1")
 
    Gauche = 10 'position par rapport au coté gauche de la Form
 
    'recherche le nombre de lignes sur la colonne "A"
    'la hauteur et largeur de chaque Label comme la cellule "A1"
    With Fe
 
        DerLg = .Cells(.Rows.Count, 1).End(xlUp).Row
        DerCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        Hauteur = .Cells(1, 1).Height
        Largeur = .Cells(1, 1).Width
 
    End With
 
    'en colonnes, de A à la dernière non vide de la 1ère ligne
    For I = 1 To DerCol
 
        Haut = 10 'position depuis le bord haut de la Form
 
        'en lignes, de 1 à la dernière non vide de la colonne A
        For J = 1 To DerLg
 
            'ajoute les Labels et les positionnent
            With Me.Controls.Add("Forms.Label.1", "Label" & I, True)
 
                .Left = Gauche
                .Top = Haut
                .Width = Largeur
                .Height = Hauteur
                .Caption = Fe.Cells(J, I).Value
                .BorderStyle = 1 'avec contour
                .TextAlign = 2 'centre le texte
 
            End With
 
            Haut = Haut + Hauteur + 10 'incrémente
 
        Next J
 
        Gauche = Gauche + Largeur + 10 'incrémente
 
    Next I
 
    'positionne le bouton centré sur les labels et juste au dessous
    With CommandButton1
 
        .Left = Gauche / 2 - .Width / 2
        '.Left = Me.Width / 2 - .Width / 2 '<-pour centré sur la Form
        .Top = Haut
        Haut = Haut + .Height + 10
 
    End With
 
    'défini les barres de défilement (correction de l'oubli sur la largeur :o(
    If Me.Height <= Haut + 30 Or Me.Width <= Gauche + Largeur Then
 
        Me.ScrollBars = fmScrollBarsBoth
        Me.ScrollHeight = Haut
        Me.ScrollWidth = Gauche
 
    End If
 
End Sub