teacup. [ 掲示板 ] [ 掲示板作成 ] [ 有料掲示板 ] [ ブログ ]

 投稿者
  題名
  内容 入力補助画像・ファイル<IMG>タグが利用可能です。(詳細)
    
 URL
[ ケータイで使う ] [ BBSティッカー ] [ 書込み通知 ] [ 検索 ]


SIMA測地系一括変換2

 投稿者:TOS  投稿日:2012年 4月25日(水)15時32分57秒
返信・引用
  http://www.n-survey.com/index.htm
使ってみたらこちらの方が良かったです。
下のはすぐに点数制限に引っかかりました。
 
 

SIMA測地系一括変換

 投稿者:TOS  投稿日:2011年11月 4日(金)23時33分20秒
返信・引用
  http://www.vector.co.jp/soft/win95/business/se412450.html
使っていませんが便利そうです。
 

動きました。

 投稿者:TOS  投稿日:2011年10月15日(土)11時46分58秒
返信・引用 編集済
  > No.145[元記事へ]

MKPさんへのお返事です。

HOの方も動きました。
これって見ていて変換しているのが分かるのでおもしろいですね。

>これを機にTOSさんもVBA、VBPのプログラムにはまるかも?(^o^)
やる気はあるのですがとっかかりが見つからなくて、つまりどこからスタートしたらよいかと言うことです。

なにしろ開発を表示したのが今日ですから。
それまで開発の存在も知りませんでした。

ただ退社後学校で3ヶ月ほどC言語勉強したのでなんとなくわかるコマンドもあります。

こんなところで勉強しようと思いますが他にお勧めがあれば教えてください。
http://kokodane.com/macro_kouza.htm

エクセルの方はデータの行数を調べて行間変更する改良版は速いです。
また最初の1分というのは間違いでした。
試行錯誤していていろいろクリックしてスタートが分かりませんでした。
再検証した結果は数秒でした。

本当に助かります。
またよろしくお願いします。
 

どうもです。

 投稿者:MKP  投稿日:2011年10月15日(土)09時05分55秒
返信・引用
  > No.144[元記事へ]

TOSさんへのお返事です。

> したのPao用についてはただ貼り付けてマクロ実行ボタンをクリックしただけでは動かないので少し調べてみます。

GB=Int(GB) を GB=Cint(GB) に変えて見て下さい。

>マクロ実行ボタンをクリック、で待つこと1分くらい、

んー、時間が掛かりすぎですね。
私のPCだと瞬時に変わりますけど、会社の古いPCでも5~6秒ぐらいかな。

もし行数が多くないシートで使う場合は、最終行を検索してその番号まで指定する。


Sub 行の高さを変更()

Dim AC, RC As Integer

Application.ScreenUpdating = False
  ActiveWorkbook.ActiveSheet.Select
   AC = ActiveCell.Row 'アクティブなセルの行 変更したい行を選択する
    RC = Range("A65536").End(xlUp).Row + 1 'A列のデータ最終行 + 1
     For I = AC To RC Step 2 '
      Rows(I).RowHeight = 30
     Next

End Sub

A列にデーターが無い場合は、必ず有るデータの列にして下さい。
それとExcel 2010の場合は、行数の上限が65536行を超え、1048576行まで指定できます。
もっともそんなデーターを扱う事は無いとは思いますが、・・・

> Step 2の2を3に変えれば2行おきに変えられそうだし、
> Rows(I).RowHeight = 15の15を20にすれば高さ20に出来そうなのでこれだけでもいろいろ使えます。

これを機にTOSさんもVBA、VBPのプログラムにはまるかも?(^o^)
 

ありがとうございます。

 投稿者:TOS  投稿日:2011年10月14日(金)20時41分54秒
返信・引用
  > No.143[元記事へ]

上のエクセルについては出来ました。

したのPao用についてはただ貼り付けてマクロ実行ボタンをクリックしただけでは動かないので少し調べてみます。

上のエクセルに着いてもエクセル2010は初期状態で開発ボタンが見つからず調べて表示させることから始めました。

たぶんコードだろうと思いコピペ、保存、エクセルの表に戻りカーソルを行の高さを変えたい中で1番上の行におきマクロ実行ボタンをクリック、で待つこと1分くらい、見事行の高さが自動変更出来ました。

助かりました。
Step 2の2を3に変えれば2行おきに変えられそうだし、
Rows(I).RowHeight = 15の15を20にすれば高さ20に出来そうなのでこれだけでもいろいろ使えます。
 

Re: VBAでしょうか

 投稿者:MKP  投稿日:2011年10月14日(金)11時24分41秒
返信・引用
  > No.142[元記事へ]

TOSさんへのお返事です。

> 記録マクロくらいしか出来ない私なので初心者向けに教えてください。

私を呼んだ?

簡単なVBAですが、コピペしてお使い下さい。

Sub 行の高さを変更()

Dim AC As Integer

Application.ScreenUpdating = False
  ActiveWorkbook.ActiveSheet.Select
   AC = ActiveCell.Row 'アクティブなセルの行 変更したい行を選択する

      For I = AC To AC + 4000 Step 2 '4000は任意の数字に変更して下さい。
      Rows(I).RowHeight = 15
     Next

End Sub

このシートを保存してから変更したいシートを開きマウスで選択してマクロを実行すればOKです。

ついでに最近作ったVBPのプログラムをPAO先生に添削してもらい、1/3にスリムに
成った物も貼付して置きます。



Option Explicit

'指定のグループのフィーチャーを種別ごとにレイヤ仕分けをします。
'うっかりレイヤー分けをしないで描いてしまった人(初心者レベル)向けです。
'既に仕分けされたCALS対応の図面には不向きなので使用しないで下さい。
'レイヤー名を変更する場合は、ご自分でVBPを編集してお使い下さい。

Sub AUTO_LAYER_SIWAKE ()

  Dim GB,LNo1,i,I1,Ft1,DistLayer1,Count1
  Dim FtTypes1,Dt1,LayerNames1

   GB = InputBox("整理するグループ番号", "入力して下さい。")
    GB = Int(GB) '整数に変換
     ActivePlan.CurrentGroupIndex = GB
       For i=0 to 15
        GroupInfo(i).State = hoc_lay_Hide
       Next
      GroupInfo(GB).State = hoc_lay_Disp

With ActivePlan.GroupInfo(GB)
  LayerNames1 = Array("文字", "線", "ポリライン", "点", "円", "楕円", "寸法", "図形", "円弧", "楕円弧", "画像", "表", "ペイント", "ハッチ", "スプライン", "オブジェクト", "マルチテキスト")
    FtTypes1 = Array(hoc_Text, hoc_Line, hoc_Polyline, hoc_Marker, hoc_Circle, hoc_Ellipse, hoc_Dim, hoc_Sfigloc, hoc_Arc, hoc_EllipseArc, hoc_Image, hoc_CellTable, hoc_FillArea, hoc_Hatch, hoc_Spline, hoc_OleObj, hoc_MultiText)
      For LNo1 = 0 To 16 'レイヤ名はまとめて設定する
       .LayerName(LNo1) = LayerNames1(LNo1)
      Next

     For LNo1 = 0 To 255 '全てのレイヤ
      DistLayer1 = 0 '変更後のレイヤ
       For Ft1 = 0 To 16 'フィーチャタイプの配列で回す
        If LNo1 <> DistLayer1 Then 'そもそも変更の発生しないレイヤは飛ばす
          Count1 = .FtrCount(FtTypes1(Ft1), LNo1) 'データの数
          If Count1 > 0 Then
            For I1 = Count1 - 1 To 0 Step -1
              Set Dt1 = .GetFtr(FtTypes1(Ft1), LNo1, I1)
              Dt1.Layer = DistLayer1 'レイヤーをセット
            Next
          End If
        End If
        DistLayer1 = DistLayer1 + 1
      Next
     Next
  End With

End Sub

これをVBPエディタにコピペして試して見て下さい。
最初に断っておきますが、CADの初心者用ですのでTOSさんには無用の長物かも。





 

VBAでしょうか

 投稿者:TOS  投稿日:2011年10月14日(金)06時07分48秒
返信・引用
  エクセルは2003と2010を使用しています。
メインは2010ですが保存形式は互換性のことも考えて2003形式です。

行間を2000行ほど1行おきに簡単に変更したいのですがこれってVBAしか無いでしょうか?
データは既に入っています、エクセル以外からエクセルに変換したデータです。

データが無い状態でしたら行コピーで出来そうですが。

具体的にはカーソル行の行間を24→15に変更
カーソルを2行下へ移動

これをキーに割り付けるのかなと思いますがどうすれば良いのか分かりません。

一気にカーソル位置から1行おきに2000行変更ならさらに楽です。
2000行と言うのは修正行の数なので修正しない行も含めると約4000行です。
その下にはデータはありませんので多少多めになるのは問題ありません。

実物を見てみると偶数行が全て幅15になれば良いのでそちらに注目するとカーソル行を考えないマクロでも良いかも知れません。

記録マクロくらいしか出来ない私なので初心者向けに教えてください。
 

トイレ修理

 投稿者:TOS  投稿日:2011年 8月14日(日)22時01分54秒
返信・引用
  http://blog.goo.ne.jp/nrp_s/e/70e6b9cb26f84a490fcf92e1b4a84de6

家の水洗トイレのオーバーフロー管が根元から折れて、タンク内に水がたまらない状態になってしまいました。

長い間使用していると壊れるのは仕方ありません。
2年ほど前便座交換下ばかりなので自力で修理をと思い調べたら上記のアドレスに行き着きました。

全て家にあった物で直りました。
パイプは塩ビ製の水道管です、こんなのが家にあるが我が家の特徴で何でも捨てられずにとっておきます。

接着剤の代わりに水道管用のシールテープを使いました、これも残っていました。
これでまたしばらく使えるとありがたいのですが。

冷蔵庫買い換えたばかりで支出を控えないと。
 

不老長寿サプリ?

 投稿者:TOS  投稿日:2011年 7月13日(水)08時55分3秒
返信・引用
  天下のNHKですからね。
http://ameblo.jp/natural-national/entry-10921994548.html
本当でしょうか?

売れすぎて欠品中の様です。
http://www.sapoo.com/resveratrol-100-50-std-ext-10-13031/review/1-1-0
私はこの年になって初めて花粉症になってしまいました。
目がかゆくなる症状です。
一度なると毎年らしいのでこれからは予防も考えなくてはなりません。
私の場合は今のところ6月7月が要注意です。

何歳でもなるときはなるのでね。
 

ハートメーカー

 投稿者:TOS  投稿日:2011年 6月28日(火)22時23分35秒
返信・引用
  http://www.style-walker.com/sw/s/heartmaker
こんなのがはやっているそうです。

脳内メーカーと同じ感じで簡単です。
私は「甘」「遊」に囲まれた「騒」

chi-さんは「妬」に囲まれた「愛」と「熱」でした。

>息抜きに是非ご参加下さりませ
chi-さん、現在いっぱいいっぱいみたいです。
私は帰った後も遅くまで仕事してます。
私と違って家事と母親業もしていて大変そうですよ。
たぶん今年は無理でしょう。

ここ数日は本人が書き込む時間もなさそうなので代筆しますが、そのうちまた書いてくれるそうです。
 

レンタル掲示板
/15