[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『[談]シートレイアウトの投稿どうしてますか？』（ｍｏｍｏ）
皆さんシートレイアウトを投稿するときにどうしてますか？ コード組まれている方もいらっしゃいますか？
毎回、意外と面倒なので作ってみました。 よろしければ使ってください。
'===================================================== ' 投稿用シートレイアウトをクリップボードに取得 ' 作成者（ｍｏｍｏ） ' ' BrkStr：列間の文字列 初期値は「|」 ' DataObjectID：DataObjectのLate Binding用（変更不可） '===================================================== Option Explicit
Sub SheetlayoutToClipBord()
Const BrkStr As String = "|"
Const DataObjectID As String = "1C3B4210-F441-11CE-B9EA-00AA006B1A69"
Dim myRng As Range, rngFormula As Range, rngBuf As Range
Dim tbl() As Variant
Dim AryTxt() As String, StrBuf As String
Dim i As Long, j As Long, AryWidth() As Long, LenBuf As Long
Set myRng = Application.InputBox("取得したい範囲を選択してください。", Type:=8)
If MsgBox("数式として表示したい範囲はありますか？", vbYesNo) = vbYes Then
Do
Set rngBuf = Application.InputBox("数式として表示したい範囲を選択してください。", Type:=8)
If rngFormula Is Nothing Then
Set rngFormula = rngBuf
Else
Set rngFormula = Application.Union(rngFormula, rngBuf)
End If
Set rngBuf = Nothing
Loop While MsgBox("さらに数式として表示したい範囲がありますか？", vbYesNo) = vbYes
End If
ReDim tbl(1 To myRng.Rows.Count, 1 To myRng.Columns.Count)
ReDim AryWidth(1 To UBound(tbl, 2))
For i = 1 To myRng.Rows.Count
For j = 1 To myRng.Columns.Count
tbl(i, j) = myRng.Cells(i, j).Text
If Not rngFormula Is Nothing Then
If Not Application.Intersect(myRng.Cells(i, j), rngFormula) Is Nothing Then
tbl(i, j) = myRng.Cells(i, j).Formula
End If
End If
LenBuf = Application.Evaluate("LENB(""" & Replace(tbl(i, j), """", vbTab) & """)")
If AryWidth(j) < LenBuf Then
AryWidth(j) = LenBuf
End If
Next j
Next i
ReDim AryTxt(UBound(tbl, 1))
AryTxt(0) = String(Len(myRng.Rows(myRng.Rows.Count).Row) + 3, " ")
For i = 1 To UBound(tbl, 2)
StrBuf = "[" & Split(myRng.Columns(i).EntireColumn.Address(False, False), ":")(0) & "]"
If AryWidth(i) > Len(StrBuf) Then
AryTxt(0) = AryTxt(0) & BrkStr & StrBuf & String(AryWidth(i) - Len(StrBuf), " ")
Else
AryTxt(0) = AryTxt(0) & BrkStr & StrBuf
AryWidth(i) = Len(StrBuf)
End If
Next i
For i = 1 To UBound(tbl, 1)
AryTxt(i) = " [" & myRng.Rows(i).Row & "]" & _
String(Len(myRng.Rows(myRng.Rows.Count).Row) - Len(myRng.Rows(i).Row), " ")
For j = 1 To UBound(tbl, 2)
LenBuf = Application.Evaluate("LENB(""" & Replace(tbl(i, j), """", vbTab) & """)")
If IsNumeric(tbl(i, j)) Then
AryTxt(i) = AryTxt(i) & BrkStr & String(AryWidth(j) - LenBuf, " ") & tbl(i, j)
Else
AryTxt(i) = AryTxt(i) & BrkStr & tbl(i, j) & String(AryWidth(j) - LenBuf, " ")
End If
Next j
Next i
With GetObject("new:" & DataObjectID)
.SetText Join(AryTxt, vbCrLf)
.PutInClipboard
End With
MsgBox "クリップボードにコピーしました。"
End Sub
（ｍｏｍｏ）2011/2/10 16:58 修正
|[B] |[C] |[D] |[E] |[F]
[2]| |4月 |5月 |6月 |7月
[3]|カラーテレビ| 1100| 540| 650| 330
[4]|掃除機 | 250| 430| 510| 310
[5]|洗濯機 | 410| 530| 580| 660
[6]|冷蔵庫 | 120| 100| 80| 130
[7]|合計 |=SUM(C3:C6)|=SUM(D3:D6)|=SUM(E3:E6)|=SUM(F3:F6)
簡単なテスト、なるほど便利ですね。（kazu）
ｍｏｍｏさん、気が付いた点があります。 時間や日付等の書式設定が活かせる方法はありますでしょうか？ [[20110209180425]] 『特定のチェック付きを抜かしたリストを関数で』（にしき） また、こちらでテスト使用させていただいた数式が反映しなかったんですよね〜 なぜだかは、検証しきれていません。。。 数式の長さではないと思うのですが・・・ 以上が気が付いた点ですｂ （キリキ）（〃⌒o⌒)b
書式設定、なるほどValueをTextにすればいいので変更します。
数式が反映されない件も調べてみます〜 （ｍｏｍｏ）
ｍｏｍｏさん♪
凄く便利ですね★改良されるのかな？ 思い切り使用させて頂きます☆彡 いつも勉強させてもらってます(^^)v
(MJ12)
MJ12さんありがとうございます。
キリキさんのご指摘の件修正しましたので試してみて頂ければと思います。
書式を加味してValueからText取得にしました。 数式が反映されない原因は数式内に「"」があったために Evaluateで文字列区切りが発生したためでしたのでTabに置換してから処理してます。
（ｍｏｍｏ）
ｍｏｍｏさん
了解です★ありがとうございます☆彡
(MJ12)
完璧ですｂ たくさん使わせていただきますね＾＾
（キリキ）(〃⌒o⌒)b
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.