ここから本文です

VBAびついてです 現在作成しているもので、どーしてもわからないのでご質問致し...

rji********さん

2016/11/1412:00:14

VBAびついてです

現在作成しているもので、どーしてもわからないのでご質問致します。

トラック納入のダイヤ表をフォーム上で作れるようにしてるんですが

フォームに
ステーション、納入便名、着時間、発時間をシート2のデーターからリスト参照し
ボタンを押すと

シート1の空のダイヤ表の部分に シェイプ図形が生成され
ハイパーリンクで時間も表示されるシステムになっています


わからない事

・ハイパーリンク表示を手動で変更した際、時間が変更されない
・シェイプの中に納入便名が表示されてるが、フォント文字色を変えれない
できれば、シート2のリストを変えると連携するようにしたい
・シェイプの中の納入便名の縦書き、横書きをフォームで設定したい

3点です

現在のコードを載せます
ご指導お願いします

Private Sub UserForm_Initialize()

Dim w As Variant
Dim i As Long
Dim t As Date

'所在地番号をチャートシートから登録
With Sheets("Sheet1") '★
With .Range("A4", .Range("A" & Rows.Count).End(xlUp))
ReDim w(1 To .Rows.Count, 1 To 2)
For i = 1 To .Rows.Count
w(i, 1) = .Cells(i).Value
w(i, 2) = .Cells(i).Row
Next
End With
End With

With ComboBox1
.MatchRequired = True
.List = w
End With

'便名を登録リストから反映。 登録外入力も可能。
ComboBox2.MatchRequired = False
With Sheets("Sheet2") '★
ComboBox2.List = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Value
End With

t = TimeSerial(6, 0, 0)
ReDim w(1 To 48 * 6, 1 To 1)
For i = 1 To UBound(w, 1)
w(i, 1) = Format(t, "h:nn")
t = DateAdd("n", 5, t)
Next

'時刻セット
ComboBox3.List = w
ComboBox3.MatchRequired = True
ComboBox4.List = w
ComboBox4.MatchRequired = True

End Sub

Private Sub CommandButton2_Click()
Dim b As Range
Dim e As Range
Dim myColor As Long

If ComboBox1.Value = "" Then
MsgBox "所在地番号が未入力です"
ComboBox1.SetFocus
Exit Sub
End If

If ComboBox2.Value = "" Then
MsgBox "便名が未入力です"
ComboBox2.SetFocus
Exit Sub
End If

If ComboBox3.Value = "" Then
MsgBox "開始時刻が未入力です"
ComboBox3.SetFocus
Exit Sub
End If

If ComboBox4.Value = "" Then
MsgBox "終了時刻が未入力です"
ComboBox4.SetFocus
Exit Sub
End If

If ComboBox3.ListIndex > ComboBox4.ListIndex Then
MsgBox "着時間より前時間は登録できません。"
ComboBox3.SetFocus
Exit Sub
End If

With Sheets("Sheet1")
Set b = .Cells(ComboBox1.List(ComboBox1.ListIndex, 1), ComboBox3.ListIndex + 2)
Set e = .Cells(ComboBox1.List(ComboBox1.ListIndex, 1), ComboBox4.ListIndex + 2)
If ComboBox2.ListIndex < 0 Then
myColor = 0
Else
myColor = Sheets("Sheet2").Cells(ComboBox2.ListIndex + 1, "A").Interior.Color


End If
addBar b, e, ComboBox2.Value, ComboBox3.Value, ComboBox4.Value, myColor
End With

End Sub
Private Sub addBar(b As Range, e As Range, cap As String, f As String, t As String, Color As Long)
Dim bar As Range
Set bar = Excel.Range(b, e)
With b.Parent.Shapes.AddShape(msoShapeRectangle, bar.Left, bar.Top, bar.Width, bar.Height)
With .Fill
.Visible = msoTrue
.ForeColor.RGB = Color
.Solid
End With
With .TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.RGB = vbBlack
.Solid
End With
With .TextFrame2
.TextRange.Characters.Text = cap
.VerticalAnchor = msoAnchorMiddle
.HorizontalAnchor = msoAnchorCenter
End With
End With

DoEvents

With b.Parent
.Hyperlinks.Add anchor:=.Shapes(.Shapes.Count), Address:="", _
SubAddress:=.Shapes(.Shapes.Count).TopLeftCell.Address, ScreenTip:=f & "~" & t
End With

End Sub

閲覧数:
119
回答数:
1
お礼:
50枚

違反報告

ベストアンサーに選ばれた回答

dog********さん

2016/11/1412:04:25

×ご質問致します。

◯質問させていただきます。

自分の質問に「ご」を付けないよーに。

この回答は投票によってベストアンサーに選ばれました!

この質問につけられたタグ

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる