わざわざご報告ありがとうございます。
当方にはＥＸＣＥＬ２０００の環境はなく再現テストができません。
ただし、Ver3.1では、今までエラーの報告はなかったため、正常に動作できるものと思っておりました。

もし今から記述することを実行していただければ原因が特定できると思いますが、内容的にはマニアックなので、できなければ特定は難しいです。

手順
①メニューから[ツール]→[マクロ]→[Visual Basic Editor]
②メニューから[ツール]→[オプション]→[全般]タブ→[エラートラップのエラー発生時に中断]を選択
③プロジェクトのEasyLoutをダブルクリック
④パスワードを請求されるので、"3"を入力
⑤エクセルのシートに戻って、行列の切替えコマンドを実行してください。
そうすればエラーが発生した行がカーソルで強調されエラーが特定できます。
それを教えていただければ非常に参考になります。

ただし、すべてはExcelXP上での方法なので、Exccel2000では若干違うかもしませんが。。

返信する

失礼しました。
OSのバージョンは？
　　WindowsXPです。
Excelのバージョンは？
　　Office2000です。
かんたんレイアウトのバージョンは？
　　当初4.3を導入後。不具合発生。
　　HP確認しExcel2000は旧バージョンでということで
　　3.1を導入中。
インストール時にはエラーにならないのでしょうか？
　　インストールに支障無し。
行列の切り替え以外のコマンドは使用できるのですか？
　　全てを試していませんが、使用できているようです。

なぜか行列の切替だけが出来ない状況です。
よろしくお願いします。

返信する

ひでさん
かんたんレイアウトをご使用頂きありがとうございます。
もう少し詳しく状況を教えていただければ幸いです。

OSのバージョンは？
EXCELのバージョンは？
かんたんレイアウトのバージョンは？

インストール時にはエラーにならないのでしょうか？
行列の切り替え以外のコマンドは使用できるのですか？

返信する

旧行列サイズ調整ツールから使用させていただいています。
この度、かんたんレイアウト最新バージョンでうまく動作しない為、旧バージョンを導入しました。
しかし、ツールバーの"列"アイコンをクリックし"行"に切り替えようとすると
実行時エラー '5':
プロシージャの呼び出し、または引数が不正です。
と表示され動きません。
対処方法をご教示ください。

返信する

'*****************************************************************************
'[ 関数名 ]　MergeRows
'[ 概 要 ]　先頭行が結合セルの時、先頭行から底の行まで縦方向に結合する
'[ 引 数 ]　objTopRow：結合の先頭行、objBottomRow：結合の底の行
'[ 戻り値 ]　なし
'*****************************************************************************
Private Sub MergeRows(ByRef objTopRow As Range, ByRef objBottomRow As Range)
Dim i As Long
Dim lngLast As Long

'選択されたすべての列を整備する
lngLast = objTopRow.Columns.Count

'1列毎にループ
For i = 1 To lngLast
'新しい行のセルが結合セルか
If objBottomRow.Cells(1, i).MergeCells = False Then
'元のセルが結合セルか
If objTopRow.Cells(1, i).MergeCells = True Then
Call Range(objTopRow.Cells(1, i).MergeArea, objBottomRow.Cells(1, i)).Merge
End If
End If
Next i
End Sub

'*****************************************************************************
'[ 関数名 ]　MergeRows2
'[ 概 要 ]　先頭行から底の行まで縦方向に結合する
'[ 引 数 ]　objTopRow：結合の先頭行、objBottomRow：結合の底の行
'[ 戻り値 ]　なし
'*****************************************************************************
Private Sub MergeRows2(ByRef objTopRow As Range, ByRef objBottomRow As Range)
Dim i As Long
Dim lngLast As Long

'最後のセルまで整備すれば終了する
lngLast = Cells.SpecialCells(xlCellTypeLastCell).Column

'1列毎にループ
For i = 1 To lngLast
'新しい行のセルが結合セルか
If objBottomRow.Cells(1, i).MergeCells = False Then
Call Range(objTopRow.Cells(1, i).MergeArea, objBottomRow.Cells(1, i)).Merge
End If
Next i
End Sub

返信する

'*****************************************************************************
'[ 関数名 ]　CopyVerticalBorder
'[ 概 要 ]　行の縦罫線をコピーする
'[ 引 数 ]　objFromRow：コピ－元の行、objToRow：コピー先の行
'[ 戻り値 ]　なし
'*****************************************************************************
Private Sub CopyVerticalBorder(ByRef objFromRow As Range, ByRef objToRow As Range)
Dim i As Long
Dim udtBorder(0 To 1) As TBorder '罫線の種類(左･右)
Dim lngLast As Long

If objFromRow.Columns.Count = Columns.Count Then
'最後のセルまで整備すれば終了する
lngLast = Cells.SpecialCells(xlCellTypeLastCell).Column
Else
'選択されたすべての列を整備する
lngLast = objFromRow.Columns.Count
End If

'1列毎にループ
For i = 1 To lngLast
'コピ－元のセルの罫線の種類を保存
udtBorder(0) = GetBorder(objFromRow.Columns(i).Borders(xlEdgeLeft))
udtBorder(1) = GetBorder(objFromRow.Columns(i).Borders(xlEdgeRight))
'コピー先のセルにコピー
Call SetBorder(udtBorder(0), objToRow.Columns(i).Borders(xlEdgeLeft))
Call SetBorder(udtBorder(1), objToRow.Columns(i).Borders(xlEdgeRight))
Next i
End Sub

'*****************************************************************************
'[ 関数名 ]　CopyBottomBorder
'[ 概 要 ]　行の下端の罫線をコピーする
'[ 引 数 ]　objFromRow：コピ－元の行、objToRow：コピー先の行
'[ 戻り値 ]　なし
'*****************************************************************************
Private Sub CopyBottomBorder(ByRef objFromRow As Range, ByRef objToRow As Range)
Dim i As Long
Dim udtBorder As TBorder '下端の罫線の種類
Dim lngLast As Long

If objFromRow.Columns.Count = Columns.Count Then
'最後のセルまで整備すれば終了する
lngLast = Cells.SpecialCells(xlCellTypeLastCell).Column
Else
'選択されたすべての列を整備する
lngLast = objFromRow.Columns.Count
End If

'1列毎にループ
For i = 1 To lngLast
'コピ－元のセルの罫線の種類を保存
udtBorder = GetBorder(objFromRow.Columns(i).Borders(xlEdgeBottom))
'コピー先のセルにコピー
Call SetBorder(udtBorder, objToRow.Columns(i).Borders(xlEdgeBottom))
Next i
End Sub

返信する

'*************************************************
'罫線を整える
'*************************************************
'挿入列の１セル毎に罫線をコピーする
Call CopyVerticalBorder(objRange.EntireRow, objNewRow)
Call CopyBottomBorder(objRange.EntireRow, objNewRow)
Call MergeRows(objRange.EntireRow, objNewRow)

'*************************************************
'分割を繰返す
'*************************************************
'分割数だけ、行を挿入する
For i = 3 To lngSplitCount
Call objNewRow.EntireRow.Insert
Next i

'*************************************************
'高さの整備
'*************************************************
'新しい高さに設定
If blnCheckInsert = False Then
If lngSplitCount = 2 Then
objRange.EntireRow.RowHeight = PixelToHeight(Int(lngPixel / 2 + 0.5))
objNewRow.EntireRow.RowHeight = PixelToHeight(Int(lngPixel / 2))
Else
With Range(objRange, objNewRow).EntireRow
If lngPixel < lngSplitCount Then
.RowHeight = PixelToHeight(1)
Else
.RowHeight = PixelToHeight(lngPixel / lngSplitCount)
End If
End With
End If
End If

'境界線を消す
With Range(objRange, objRange(lngSplitCount, 1)).EntireRow
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
'*************************************************
'後処理
'*************************************************
Call Range(objRange, objRange(lngSplitCount, 1)).Select
If blnCheckInsert = False Then
Call ResetPlacement
End If
Call SetOnUndo

If blnDisplayPageBreaks = True Then
ActiveSheet.DisplayAutomaticPageBreaks = True
End If
Application.ScreenUpdating = True
Exit Sub

返信する

'*****************************************************************************
'[ 関数名 ]　GetCellText
'[ 概 要 ]　Cellの文字列を表示された書式で取得する
'[ 引 数 ]　対象のセル
'[ 戻り値 ]　文字列
'*****************************************************************************
Public Function GetCellText(ByRef objCell As Range) As String
On Error GoTo ErrHandle
Select Case objCell.NumberFormat
Case "General", "@"
GetCellText = RTrim$(objCell.Value)
Exit Function
End Select

If objCell.Text <> WorksheetFunction.Rept("#", Len(objCell.Text)) Then
GetCellText = RTrim$(objCell.Text)
Exit Function
End If

If IsDate(objCell.Value) Then
GetCellText = WorksheetFunction.Text(objCell.Value, objCell.NumberFormatLocal)
Exit Function
End If

If IsNumeric(objCell.Value) Then
GetCellText = objCell.Value
Exit Function
End If
ErrHandle:
GetCellText = RTrim$(objCell.Value)
End Function

返信する

frmEdit.OnPopupClick
「切取り」にバグあり

Styleコレクションの削除が必要

返信する

・ChangeTextboxtoCellで結合されたセルがある時、セルを選択させる
・重複エリアのチェック時にIntersectRange関数を使用するように修正する
・AutoColFit関数で、Intersect→IntersectRangeに変更すべきバグ有
・RecoverShapeSizeで、Height,Width,Top,Leftの順で復元させる(MoveShape,MoveCellフォームも一緒に修正)
・RecoverClipbordでclearメソッドを実行
・MoveCellコマンドで切取ったセルの挿入で、「大きさを変更出来ません」メッセージを修正
・ParseCellで改行のみの時の対応を入れる
・TextboxToCellで、Workbookを開いていないときにエラーを出さなくする
・AutoFilter,AdvancedFileterの整理
・TPos構造体のLengthをLongにする
・MoveCellのヘルプを変更、「Ctrl+C,Ctrl+Xを実行しては作業できること」
・「かんたんレイアウトアイコン」ツールバーのOnActionプロパティのクリア
・UnselectコマンドSelectionオブジェクトのチェックを追加

返信する

'*****************************************************************************
'[ 関数名 ]　GetMaxMergeWidth
'[ 概 要 ]　横方向の結合の最大幅を取得する
'[ 引 数 ]　調査する領域、左端のColumn番号
'[ 戻り値 ]　なし
'*****************************************************************************
Private Function GetMergeCol(ByRef objCol As Range, ByRef objSelection As Range) As Range
Dim objRange As Range
Dim objWkRange As Range

Set objWkRange = ArrangeRange(Intersect(objCol, objSelection))

'選択範囲のColumnsの和集合を取り重複列を排除する
Set objRange = Union(objWkRange.EntireColumn, objWkRange.EntireColumn)

While (True)
Set objWkRange = ArrangeRange(Intersect(objRange, objSelection))

'選択範囲のColumnsの和集合を取り重複列を排除する
Set GetMergeCol = Union(objWkRange.EntireColumn, objWkRange.EntireColumn)

If GetMergeCol.Address = objRange.Address Then
Exit Function
End If
Set objRange = GetMergeCol
Wend
End Function

返信する

'*****************************************************************************
'[ 関数名 ]　GetDoRange
'[ 概 要 ]　横方向の結合セルがある時、一番結合幅が広いセルのみ実行対象とする
'[ 引 数 ]　選択されたセル
'[ 戻り値 ]　実行対象のセル
'*****************************************************************************
Private Function GetDoRange(ByRef objSelection As Range) As Range
Dim objArea As Range
Dim i As Long
Dim objLeftCol As Range
Dim objRightCol As Range
Dim objWkRange(1 To 2) As Range
Dim lngMaxMergeWidth As Long
Dim objMergeCol As Range

For Each objArea In objSelection.Areas
For i = 1 To objArea.Columns.Count
Set objMergeCol = GetMergeCol(objArea.Columns(i).EntireColumn, objSelection)
Set objLeftCol = objMergeCol.Columns(1)
Set objRightCol = objMergeCol.Columns(objMergeCol.Columns.Count)
Set objWkRange(1) = ArrangeRange(Intersect(objLeftCol, objSelection))
Set objWkRange(2) = ArrangeRange(Intersect(objRightCol, objSelection))
Set GetDoRange = UnionRange(GetDoRange, Intersect(objWkRange(1), objWkRange(2)))
i = i + objMergeCol.Columns.Count - 1
Next i
Next
End Function

返信する

簡単ブックマーク、いいですね。
ワード本体にデフォルトでついてほしいくらい、いいです。
ところで、設定ファイル（テキストファイル）に行単位に設定されたタグ文字列を文書中からサーチして自動的にその位置にブックマークを付与する機能（と設定ボタン）があると有り難いとおもいました。
定型的な複数のタグ文字列を含む文書は多々ありますので、この機能があると、一層便利になるとおもいます。

返信する

セルの分割は、新規作成のシートでは動作しますが、すでにセルの結合をされているシートなどでやろうとするとエラーになるようです。
新しく気づいた点では、セルをテキストボックスに変換はできますが、テキストボックスをセルに変換しようとすると「型が一致しません」となり、変換できません。

返信する

大変便利なソフトだと思います。しかしExcel2007にてセル分割をすると、Rangeメソッドは失敗しましたWorksheetオブジェクトとでてできません。Excel2007には対応できないでしょうか?

返信する

ありがとうございます。
旧バージョン試してみました。
アドインまでは出来たのですが、いざツールバーのボタンを押してみると、
「オブジェクトは、このプロパティまたはメソッドをサポートしていません。」とのメッセージが出て、うまく作動しません。
基本的な準備が出来ていないのであれば申し訳ないのですが、解消方法をお教え下さい。よろしくお願いします。

返信する

旧バージョンをダウンロード出来るようにしました。
http://takana.web5.jp/EasyLout/oldversion/OldDownload.htm
お試し下さい。

返信する

①EXCEL2000でエラーが起こる件について
わたしはVBAには詳しくないのですが，ぜひEXCEL2000で使ってみたかったので、いろいろやってみました。
結論から言うと、標準モジュールのEleseToolのSetCommandのアイコンの設定のところの
8行目の　Set objMask = .Picture
と
13行目の　.Mask = objMask
を無効にしたら動いています。
まだ少ししか使っていないので、不都合が出てくるかも知れませんがとりあえずご報告いたします。

返信する

現在「かんたんレイアウト」で以下の点になやんでいます。
当方には、Excel2000およびExcel2007の動作環境がないため原因の究明ができません。
原因を特定出来る方、申し訳ありませんが、ご協力下さい。

①Ecxel2000で、モジュールElseTool内でコンパイルエラーが発生する
②Excel2007で、セルの分割を行おうとしたらRangeメソッドは失敗しましたとエラーになる。

返信する

エクセル2000を使っていますが、うまくアドインできません。
何卒、御教示ください。

返信する