- Excel Version
- 2016
The Ukrainian flag is rather easy to draw, and here we will see six distinct ways to do it:
- 2 user forms without title and borders
- 2 worksheet cells
- A Word table
- A chart
- 2 shapes
- 2 text boxes
VBA Code:
Option Explicit
Rem standard module
#If VBA7 Then
Private Declare PtrSafe Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" (ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" (ByVal hWnd As Long, _
ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function DrawMenuBar Lib "user32" ( _
ByVal hWnd As Long) As Long
Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32" ( _
ByVal hWnd As Long, ByVal crKey As Long, _
ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
#Else
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" ( _
ByVal hWnd As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" ( _
ByVal hWnd As Long, _
ByVal crKey As Long, _
ByVal bAlpha As Byte, _
ByVal dwFlags As Long) As Long
#End If
Public ftop, fh
Private Const GWL_STYLE As Long = -16
Private Const GWL_EXSTYLE As Long = -20
Private Const WS_CAPTION As Long = &HC00000 'Style for titlebar
Private Const WS_EX_DLGMODALFRAME As Long = &H1
Sub HideTBB(frm As Object)
Dim wd&, fh&
fh = FindWindow(vbNullString, frm.Caption)
SetWindowLong fh, GWL_STYLE, GetWindowLong(fh, GWL_STYLE) And (Not WS_CAPTION)
SetWindowLong fh, GWL_EXSTYLE, GetWindowLong(fh, GWL_EXSTYLE) And Not WS_EX_DLGMODALFRAME
DrawMenuBar fh
End Sub
Sub Run_me()
UserForm1.Show vbModeless
UserForm2.Show vbModeless
End Sub
Sub ColumnW_MM(ColNo&, mmWidth%)
Dim w!
If ColNo < 1 Or ColNo > 255 Then Exit Sub
Application.ScreenUpdating = False
w = Application.CentimetersToPoints(mmWidth / 10)
While Columns(ColNo + 1).Left - Columns(ColNo).Left - 0.1 > w
Columns(ColNo).ColumnWidth = Columns(ColNo).ColumnWidth - 0.1
Wend
While Columns(ColNo + 1).Left - Columns(ColNo).Left + 0.1 < w
Columns(ColNo).ColumnWidth = Columns(ColNo).ColumnWidth + 0.1
Wend
End Sub
Sub RowH_MM(RowNo&, mmHg%)
If RowNo < 1 Or RowNo > 65536 Then Exit Sub
Rows(RowNo).RowHeight = Application.CentimetersToPoints(mmHg / 10)
End Sub
Sub Cells2() ' two cells
ColumnW_MM 3, 120
RowH_MM 3, 40
ColumnW_MM 3, 120
RowH_MM 4, 40
With [c3].Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = RGB(5, 90, 180)
End With
With [c4].Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = RGB(250, 210, 5)
End With
End Sub
Sub Chart2()
Dim ch As Shape, ya As Axis
Set ch = ActiveSheet.Shapes.AddChart _
(Left:=90, Top:=5, Width:=440, Height:=190)
With ch.Chart
.SeriesCollection.NewSeries
.SeriesCollection(1).Values = Array(100)
.SeriesCollection.NewSeries
With .SeriesCollection(1)
.XValues = Array("Chart")
.ChartType = xlColumnStacked
.AxisGroup = 1
.Format.Fill.ForeColor.RGB = RGB(250, 210, 5)
End With
With .SeriesCollection(2)
.Values = Array(100)
.ChartType = xlColumnStacked
.AxisGroup = 1
.Format.Fill.ForeColor.RGB = RGB(5, 90, 180)
End With
.HasTitle = 0
Set ya = .Axes(xlValue)
ya.Delete
.ChartArea.Font.Color = vbWhite
.ChartArea.Interior.ColorIndex = 1
.HasLegend = False
.Axes(xlCategory).MajorGridlines.Delete
.Axes(xlCategory).TickLabels.Font.Size = 20
.ChartGroups(1).GapWidth = 150
End With
End Sub
Sub Two_Shapes()
Dim s(2) As Shape
Const uni = 90
Set s(1) = ActiveSheet.Shapes.AddShape _
(msoShapeRectangle, 170, 285, uni * 3, uni)
With s(1).Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(5, 90, 180)
.Transparency = 0
.Solid
End With
With s(1).Line
.Visible = msoTrue
.ForeColor.RGB = RGB(5, 90, 180)
.Transparency = 0
End With
Set s(2) = ActiveSheet.Shapes.AddShape _
(msoShapeRectangle, 170, 285 + s(1).Height, uni * 3, uni)
With s(2).Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(250, 210, 5)
.Transparency = 0
.Solid
End With
With s(2).Line
.Visible = msoTrue
.ForeColor.RGB = RGB(250, 210, 5)
.Transparency = 0
End With
End Sub
Sub ole()
Dim tb(2) As OLEObject
Const uni = 100
Set tb(1) = ActiveSheet.OLEObjects.Add(ClassType:="Forms.TextBox.1", Link:=False, _
DisplayAsIcon:=False, Left:=300, Top:=600, Width:=uni * 3, Height:=uni)
tb(1).Object.BackColor = RGB(5, 90, 180)
Set tb(2) = ActiveSheet.OLEObjects.Add(ClassType:="Forms.TextBox.1", Link:=False, _
DisplayAsIcon:=False, Left:=300, Top:=600 + uni - 7, Width:=uni * 3 - 2, Height:=uni)
tb(2).Object.BackColor = RGB(250, 210, 5)
tb(2).Object.BorderColor = RGB(250, 210, 5)
tb(2).Object.SpecialEffect = fmSpecialEffectFlat
End Sub
Sub Word_table()
Dim t As Word.Table, wap As Object
Set wap = CreateObject("Word.Application")
wap.Visible = True
wap.documents.Add template:="Normal", newtemplate:=False, documenttype:=0
Set t = wap.ActiveDocument.Tables.Add(Range:=wap.Selection.Range, NumRows:=2, NumColumns:= _
1, DefaultTableBehavior:=1, AutoFitBehavior:=wdAutoFitFixed)
t.PreferredWidthType = wdPreferredWidthPoints
t.PreferredWidth = InchesToPoints(6)
t.Rows(1).Shading.BackgroundPatternColor = RGB(5, 90, 180)
t.Rows(2).Shading.BackgroundPatternColor = RGB(250, 210, 5)
t.Borders.Enable = 0
t.Rows.SetHeight InchesToPoints(2), wdRowHeightExactly
wap.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
wap.Selection.Font.Size = 26
wap.Selection.TypeText Text:="Word table"
wap.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub
VBA Code:
Rem UserForm1 module
Private Sub UserForm_Initialize()
HideTBB Me
Me.Width = 200
Me.Height = Me.Width * 0.333
Me.StartUpPosition = 0
ftop = (Application.Height - Me.Height) / 2
Me.Top = ftop
Me.Left = (Application.Width - Me.Width - 50)
fh = Me.Height
Me.BackColor = RGB(5, 90, 180)
End Sub
Private Sub UserForm_Click()
Unload Me
End Sub
Rem UserForm2 module
Private Sub UserForm_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
HideTBB Me
Me.Width = 200
Me.Height = Me.Width * 0.333
Me.StartUpPosition = 0
Me.Top = ftop + fh - 5
Me.Left = (Application.Width - Me.Width - 50)
Me.BackColor = RGB(250, 210, 5)
End Sub