No.6ベストアンサー
- 回答日時:
肝心の使い方を書いてませんでした。
失礼しました。進捗率の数字を記入すると自動で帯を引きます。
複数セルに一度に記入・編集しても構いません。ただし進捗率を生数字を記入している前提です。数式で実は進捗率を計算させていたときは,このマクロは使えません。
それとコードを一カ所(実際は2カ所)直します。そういえば前のご質問でテキストボックスを使っていたのは残します。前回の回答のコードを削除し,下記をコピー貼り付け直します。コードを記入するシートの呼び出し方を,回答した手順と違うやり方でやって間違えないよう注意して操作してください。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim h As Range
Dim ha As Range
Dim hs As Range
Dim s As object
Set hs = Application.Intersect(Target, Range("D4:D9"))
If hs Is Nothing Then Exit Sub
For Each ha In hs.Areas
For Each h In ha
For Each s In ActiveSheet.rectangles
If s.TopLeftCell.Row = h.Row Then s.Delete
Next s
If h > 0 Then
ActiveSheet.Shapes.AddShape _
Type:=msoShapeRectangle, _
Left:=h.Offset(0, 1 + h.Offset(0, -2) - Range("B2")).Left, _
Top:=h.Top + h.Height / 2, _
Width:=h.Offset(0, 1 + h.Offset(0, -2) - Range("B2")).Resize(1, 1 + h.Offset(0, -1) - h.Offset(0, -2)).Width * h / 100, _
Height:=h.Height / 2
End If
Next
Next
End Sub
#またご利用のソフトのバージョンをご質問に書いていません。マクロが動かない原因になるので,今度こそは忘れないようになさってください。
この回答への補足
ソフトのバージョン記入、失念しておりました(Excel 2007)。確かに動かないことがありますね。
試してみたのですが、同じ行にあるテキストボックスが消えてしまいます。
残すことができないでしょうか。
No.8
- 回答日時:
>試してみたのですが、同じ行にあるテキストボックスが消えてしまいます。
>残すことができないでしょうか。
本当に間違いなく改訂版のマクロを試して,それでテキストボックスが消えたのですか?
もし間違いなくそうなのでしたら,あなたがいま使っている「テキストボックスの追加」は,以前のご相談で見ていたマクロと違いますね。
その場合は最初のご相談でお話ししておいたように,既存のマクロとすり合わせて全体としての調整が必要です。情報が足りませんので,残念ながら適切なアドバイスは出来ません。
No.5
- 回答日時:
No.4
- 回答日時:
No.3
- 回答日時:
下記のマクロを作成しました。
ボタン等で実行するようにして下さい。
1.最初にシェープ(線)をすべて消しています。
2.開始日は考慮しています。作業工程表示開始日が6/6 で 工程開始が6/4 等々
3.終了日は考慮していませんので、工程日数分線が引かれてしまいます。
4.線を引くためにE列~は全て列幅を同じにして下さい。
5.線の太さ・色・線種・縦位置は随時変更して下さい。
Sub ライン表示()
With ActiveSheet
For I = .Shapes.Count To 1 Step -1
.Shapes(I).Delete
Next I
最終行 = Cells(Rows.Count, "A").End(xlUp).Row
For 行 = 4 To 最終行
日数 = Cells(行, "C") - Cells(行, "B") + 1
進捗日数 = 日数 * Cells(行, "D") / 100
Select Case True
Case Range("B2") <= Cells(行, "B")
開始列 = Cells(行, "B") - Range("B2")
Case Else
開始列 = 0
進捗日数 = 進捗日数 - (Range("B2") - Cells(行, "B"))
End Select
If 進捗日数 > 0 Then
縦位置 = Cells(行 + 1, "E").Top - 4
横位置 = Cells(行, "E").Offset(0, 開始列).Left
横幅 = Cells(行, "E").Width * 進捗日数
.Shapes.AddLine(横位置, 縦位置, 横位置 + 横幅, 縦位置).Select
Selection.ShapeRange.Line.Weight = 4
Selection.ShapeRange.Line.ForeColor.SchemeColor = 10
End If
Next 行
End With
End Sub
この回答への補足
ご回答ありがとうございます。まさにやりたかったことです。
最初に線を消しますが、描いた線のみを消すことができないでしょうか。
サンプル画像にはありませんが、■が表示されるエリア部分にテキストボックスでコメントを表示し、残したく思います。
No.2
- 回答日時:
シート名タブを右クリックしてコードの表示を選び,現れたシートに下記のようにコピー貼り付ける。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim h As Range
Dim ha As Range
Dim hs As Range
Dim s As Shape
Set hs = Application.Intersect(Target, Range("D4:D9"))
If hs Is Nothing Then Exit Sub
For Each ha In hs.Areas
For Each h In ha
For Each s In ActiveSheet.Shapes
If s.TopLeftCell.Row = h.Row Then s.Delete
Next s
If h > 0 Then
ActiveSheet.Shapes.AddShape _
Type:=msoShapeRectangle, _
Left:=h.Offset(0, 1 + h.Offset(0, -2) - Range("B2")).Left, _
Top:=h.Top + h.Height / 2, _
Width:=h.Offset(0, 1 + h.Offset(0, -2) - Range("B2")).Resize(1, 1 + h.Offset(0, -1) - h.Offset(0, -2)).Width * h / 100, _
Height:=h.Height / 2
End If
Next
Next
End Sub
#いま現在あなたが他に運用しているマクロ?と,色々調整がいるかもしれません。
そういった微調整を含めエラー対策等も特に施していませんので,もう少し実際の様子に合わせて調整してから使ってください。
再作成の依頼はご容赦方。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- その他(教育・科学・学問) 進捗率の計算方法を教えてください。 90日の売上目標500万 20日経過時点で100万。 予定の進捗 1 2022/08/22 12:10
- Excel(エクセル) Excelのマクロについてご教授ください 2 2023/02/25 09:43
- Visual Basic(VBA) Excelにて、指定した日の午後にファイルを開いたらsheet1に UserForm1を表示させたい 2 2022/05/31 20:53
- その他(パソコン・スマホ・電化製品) CMD等でPC操作(excel開く等)を自動化させたい 1 2023/03/15 09:53
- Windows 10 ディスククリーンアップ 2 2023/01/03 18:59
- Excel(エクセル) エクセルのマクロについて質問があります。 sheet1に数字を入力してsheet2を印刷したいのです 2 2023/06/07 14:49
- Yahoo!メール 2つ目のヤフーメールの開設について 2 2023/07/31 10:10
- Excel(エクセル) Excelシフト表 固定シフトの自動変換化 1 2022/04/14 16:10
- Excel(エクセル) Excelのtextboxへの入力で小数点以下に0が続く場合でも正しく表示したい 3 2022/04/11 13:53
- Visual Basic(VBA) VBA 複数のブックに同じ列を表示させる方法 2 2022/07/20 23:49
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excel・Word リサーチ機能を無...
-
エクセルで特定の列が0表示の場...
-
Excel VBAからAccessマクロを実...
-
メッセージボックスのOKボタ...
-
一つのTeratermのマクロで複数...
-
Excel マクロ VBA プロシー...
-
IF関数を使ってマクロを実行さ...
-
特定のPCだけ動作しないVBAマク...
-
ExcelVBAでPDFを閉じるソース
-
Excel マクロでShearePoint先の...
-
エクセルで別のセルにあるふり...
-
ExcelのVBA。public変数の値が...
-
マクロ実行時、ユーザーフォー...
-
エクセルのマクロについて教え...
-
【Excel】スケジュール表 進捗...
-
エクセルで縦に並んだデータを...
-
Sub ***( ) と Private Sub ***...
-
エクセルのマクロについて教え...
-
ソース内の行末に\\
-
EXCELのVBAでRange("A1:C4")を...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excel・Word リサーチ機能を無...
-
特定のPCだけ動作しないVBAマク...
-
エクセルで特定の列が0表示の場...
-
Excel マクロ VBA プロシー...
-
メッセージボックスのOKボタ...
-
一つのTeratermのマクロで複数...
-
ExcelのVBA。public変数の値が...
-
Excel VBAからAccessマクロを実...
-
TERA TERMを隠す方法
-
ExcelVBAでPDFを閉じるソース
-
エクセルに張り付けた写真のフ...
-
EXCELのVBAでRange("A1:C4")を...
-
エクセルで別のセルにあるふり...
-
ソース内の行末に\\
-
マクロ実行時、ユーザーフォー...
-
特定文字のある行の前に空白行...
-
エクセルVBA
-
マクロの記録を使用したマクロ...
-
wordを起動した際に特定のペー...
-
ダブルクリックで貼り付けた画...
おすすめ情報