いま選択しているページだけ印刷(特定のセルのページ番号を取得)

Excel VBA 
' Printout Current Page
'アクティブなセルのあるページだけ印刷
Public Sub PrintCurrentPage()
    Dim PageNumber As Long
    PageNumber = PageNumberOf(ActiveCell),
   
    s.PrintOut From:= PageNumber , To:=PageNumber
End Sub

'特定のセルのページ番号を取得
'RangeのTopLeftCellのページ番号を取得
Function PageNumberOf(c As Range) As Long
    Dim s As Worksheet
    Set s = c.Worksheet

    Dim ActiveRow As Long, ActiveCol As Long
    ActiveRow = c.Row
    ActiveCol = c.Column
    
    Dim i As Long
    '上から何ページ目
    Dim PageRow As Long
    PageRow = 1
    Dim HPBCount As Long
    HPBCount = s.HPageBreaks.Count
    For i = 1 To HPBCount
        If ActiveRow < s.HPageBreaks(i).Location.Row Then
            Exit For
        Else
            PageRow = PageRow + 1
        End If
    Next
    
    '左から何ページ目
    Dim PageCol As Long
    Dim VPBCount As Long
    VPBCount = s.VPageBreaks.Count
    PageCol = 1
    For i = 1 To VPBCount
        If ActiveCol < s.VPageBreaks(i).Location.Column Then
            Exit For
        Else
            PageCol = PageCol + 1
        End If
    Next

    'ページの印刷方向("左から右"か"上から下"か)によってページ数は変わる
    Dim PageNumber As Long
        If s.PageSetup.Order = xlDownThenOver Then '左端から右へ  ↓＼↓＼↓＼↓
            PageNumber = (s.HPageBreaks.Count + 1) * (PageCol - 1) + PageRow
        Else '上から下
            PageNumber = (s.VPageBreaks.Count + 1) * (PageRow - 1) + PageCol
        End If
    PageNumberOf = PageNumber
End Function

横方向にセル連結

Word

複雑な表の作成を行う方は、クイックアクセスツールバーに入れておくと便利かもしれません。

単に連結させると、セル区切りで改行が入ってしまうので取り除いています。
*1と*2の行を削除すると単にセルの連結のみ行ないます。

Sub 横セル連結()
    Application.ScreenUpdating = False
    Dim c As Cell
    Dim RowIndex As Long
    Dim FirstCell As Cell
    RowIndex = 0
    Set FirstCell = Selection.Cells(1)
    For Each c In Selection.Cells
        If RowIndex = c.RowIndex Then
            Dim Text As String
            Text = Chop(FirstCell.Range.Text) & " " & Chop(c.Range.Text) '*1
            FirstCell.Merge c
            FirstCell.Range.Text = Text ' *2 
        Else
            Set FirstCell = c
            RowIndex = c.RowIndex
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Function Chop(Str As String) As String
    Chop = Left(Str, Len(Str) - 2)
End Function

Google Spreadsheet セルの値を配列を使用してコピー 

// Google Spreadsheet のイディオム
// セルの値を配列を使用してコピー
// 
function CopyCellValueByUsingArray() {
  var address = "A1:D8";
  var top = 2;
  var left = 6;

  //テストデータの用意
  var sheet = SpreadsheetApp.getActiveSheet();
  sheet.clearContents();
  var sourceCells =  sheet.getRange(address);
  for(var r = 1;r < sourceCells.getNumRows()+1;r++){
    for(var c = 1; c < sourceCells.getNumColumns()+1;c++){
      var cell = sourceCells.getCell(r, c);
      Logger.log(r +" " + c);
      cell.setValue(cell.getA1Notation());
    }
  }
  
  // A1:D8 を F2セルを先頭にコピー  
  var valueArray = sourceCells.getValues();
  sheet.getRange(top, left,valueArray.length,valueArray[0].length).setValues(valueArray);

}

千年に一度

何年かぶりにlogとか持ち出して計算してみました

1000年に一度の事件がここ10^x年でおこる確率

おこらない確率pとすると
p=(1-10^-3)^x
log p = x log(0.999) = x log(0.001*999)=x(log(999)-3)=-0.00043x

p=10^-0.00043x

おこる確率は 1-p なので

ここ10年で起こる確率は x=1 として
0.995512 ≒ 1 %

ここ100年で起こる確率 x=2 として
0.095208 ≒ 10%

原発の設計にあたって想定外といってはいけない数字ですね

Microsoft Office2010買ってみた

Microsoft OFFICEはずっと2003のままだったんだけど
家マシンに2010買って入れてみた。
・うちのマシンでは起動はすごく速くなった
・動作も機敏な感じがする
・一部で評判の悪いリボンは自分にはそんなに違和感ない。むしろWordのスタイル機能の使い勝手が上がっているのでうれしい。
・スタイルの編集がかなり良くなっていてうれしい。
・2003ではWordの差し込み印刷周りで困ったバグがいくつかあったのだがそれは直っているのか、未確認
・VBEは代わり映えしない。リファクタリング支援機能もついていない、変数名や関数名の変更さえない。
・.NET文法とか、その他今時のスクリプトに対応して欲しかったが、やっぱりだめだったか。
・単体テストとかもできない。
・ツールバーを使った開発が、リボンを使ってどうなるのか、まだよくわかんない。

以上

WORD 差し込み印刷でレコード1件1ファィルで保存する方法

WORD VBA 
'===ポイント===
'レコードの移動は、MailMerge.DataSource.ActiveRecord の設定により行う
' MailMerge.DataSource.Included プロパティの設定により、差し込みデータに含むかどうか設定できる

Sub MakeResultFiles()

    ' ファィル名に使うキーとなるフィールド うちは学校なので学籍番号
    Const KeyField = "学籍番号"
    Dim FolderName As String
    FolderName = ThisDocument.Path & "\work\"

    Dim Last As Long
    Last = -1
    With ThisDocument.MailMerge.DataSource
        .SetAllIncludedFlags False
        .ActiveRecord = wdFirstDataSourceRecord
        
        While .ActiveRecord <> Last
            Last = .ActiveRecord

            .Included = True
            Dim StudentID As String
            StudentID = .DataFields(KeyField)
            
            ThisDocument.MailMerge.Execute
            Dim doc As Document
            Set doc = ActiveDocument
            
            Dim FileName As String
            'うちの場合 健康診断だったのでこんなファイル名にしました。
            FileName = "kenko" & StudentID & ".doc"
                        
            doc.SaveAs FolderName & FileName
            doc.Close
            .Included = False
            .ActiveRecord = wdNextDataSourceRecord
        Wend
        
        .SetAllIncludedFlags True
    End With
End Sub