教えてください

質問

アスタリスクを使ってピラミッドを作るコードを教えてください。
底辺は７のとき、８のときの２とおりです。
Ｖｂできる方、お願いします。

回答No.5

Hk2001 · ベストアンサー

テキストBOXなどのプロパティを使用すれば簡単にできるような気がします。
テキストBOX以外でも複数行表示や中央揃えができるオブジェクトなら応用可能
だとおもいます。
スペースで補正するやり方は、フォントなどに左右されます。Pが付いてるフォントは避けたほうがいいと思います。

一応サンプルコード書いときます。

オブジェクト
========= ==============
Form Form1
TextBox Text1
Text2
Command
Button Command1
Command2
Command3
Command4

プロパティ設定
'Text1.MultiLine を設計時にTrue
'Text1.Alignment を設計時に中央
'Text2.MultiLine を設計時にTrue
'Text2.Alignment を設計時に左

ソース
↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓

Option Explicit

'※※※※※※※※※※※※※※※※※
'ボタンのクリック７編テキストボックスのプロパティ使用版
'※※※※※※※※※※※※※※※※※
Private Sub Command1_Click()

Call FlTextBoxP(7)

End Sub

'※※※※※※※※※※※※※※※※※
'ボタンのクリック８編テキストボックスのプロパティ使用版
'※※※※※※※※※※※※※※※※※
Private Sub Command2_Click()

Call FlTextBoxP(8)

End Sub

'※※※※※※※※※※※※※※※※※
'ボタンのクリック７編スペース使用版
'※※※※※※※※※※※※※※※※※
Private Sub Command3_Click()

Call FlTextBoxS(7)

End Sub

'※※※※※※※※※※※※※※※※※
'ボタンのクリック８編スペース使用版
'※※※※※※※※※※※※※※※※※
Private Sub Command4_Click()

Call FlTextBoxS(8)

End Sub

'※※※※※※※※※※※※※※※※※
'テキストボックスのプロパティ使用版
'※※※※※※※※※※※※※※※※※
Private Function FlTextBoxP(ByVal vlStrLen As Long) As Long

Dim lCnt As Long

'Text1.MultiLine を設計時にTrue
'Text1.Alignment を設計時に中央

Text1.Text = "" 'クリア
lCnt = vlStrLen 'ループカウント

Do Until lCnt <= 0

'初回以外改行を加える
If Text1.Text <> "" Then
Text1.Text = vbCrLf & Text1.Text
End If

'残りカウント分*を表示
Text1.Text = String(lCnt, "*") & Text1.Text

'カウント減算
lCnt = lCnt - 1

Loop

End Function

'※※※※※※※※※※※※※※※※※
'テキストボックスのスペース使用版
'※※※※※※※※※※※※※※※※※
Private Function FlTextBoxS(ByVal vlStrLen As Long) As Long

Dim lwCnt As Long
Dim lCnt As Long
Dim sSpaceStr As String
Dim sPrintStr As String

'Text2.MultiLine を設計時にTrue
'Text2.Alignment を設計時に左
Text2.Font = "ＭＳ ゴシック"

Text2.Text = "" 'クリア
lCnt = vlStrLen 'ループカウント

Do Until lCnt <= 0

'初回以外改行を加える
If Text2.Text <> "" Then
Text2.Text = vbCrLf & Text2.Text
End If

sSpaceStr = ""
If vlStrLen - lCnt <> 0 Then
sSpaceStr = String(vlStrLen - lCnt, " ")
End If
sPrintStr = String(lCnt, "＊")
Text2.Text = sSpaceStr & sPrintStr & Text2.Text

'カウント減算
lCnt = lCnt - 1

Loop

End Function

お礼

ありがとうがざいました